ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] [excel2003 vba]¤À²Õ°ÝÃD

[µo°Ý] [excel2003 vba]¤À²Õ°ÝÃD

¦U¦ì«e½ú¤j®a¦n

°²³]¤p§Ì¤âÃ䦳¨Ç¸ê®Æ,

¬O³\¦h¤£¯S©wªø«×ªº¦r¦ê,
¦r¦ê¥»¨­¥i¯à¬°²Å¸¹©Î¤å¦r,¦ý¤£·|¬O¼Æ¦r,¤]¤£·|¬O°ê¦rªº¤@¨ì¤E.

¨C­Ó¦r¦ê§¡¥H¤¤¤å©Î­^¤å¼Æ¦r°µµ²§À,¤£¥i¯à¦P®É¦³­^¤å¤S¦³¤¤¤å¼Æ¦r.
½d³ò¬°1~9©ÎªÌ¬O°ê¦rªº¤@¨ì¤E.

§Æ±æ¥i¥H±N¥¦­Ì¨Ìµ²§Àªº¼Æ¦r¤À²Õ,
1©Î¤@¬°²Ä¤@²Õ,2©Î¤G¬°²Ä¤G²Õ,3©Î¤T¬°²Ä¤T²Õ,
¥H¦¹Ãþ±À.
­Y¬O¹J¨ì§ÀºÝ¨S¦³¼Æ¦rªº¸ê®Æ,
«h¥t¥~¤ÀÃþ¦Ü"¥¼¤ÀÃþ",¦Û¦¨¤@²Õ.
±N¤À²Õ«áªºµ²ªG¿é¥X¦Ü¥t¤@­¶ÅÒ, ¨Ã¦b²Õ¦Wªº«á¤è¦C¥X²Õ¤º¦¨­ûÁ`¼Æ.
¦r¦ê«áªº¤£½×¤¤¤å©Î­^¤å¼Æ¦r§¡§R°£.

²Õ¦W¦b¨ä¤¤¤@­Ó­¶ÅÒ¥i¥H¤â°Ê¶i¦æ½s¿è.

ÀɮץܷN·Ð½Ð°Ñ¦Ò¥H¤U³sµ²:
http://ppt.cc/g6Fl
¨ä¤¤¿é¤J¸ê®Æ¥u¬O¬°¤è«K¾\Ū¦Ó±Æ¦C¾ã»ô¨Ã±N¦U²Õ¼Æ¶q¥Î¦¨¤@¼Ë,¹ê»Ú®³¨ìªº¸ê®Æ·|¬OÀH¾÷±Æ¦Cªº,¤£·|¥þ³¡³£¬O­^¤å,¼Æ¶q¤]¤£¤@©w¬Û¦P.

§Æ±æ¦U¦ì«e½ú¯à¤©¥H¨ó§U,·PÁÂ

¥»©«³Ì«á¥Ñ yen956 ©ó 2014-4-1 19:48 ½s¿è

¸Õ¸Õ¬Ý:
  1. Option Base 1
  2. Option Explicit
  3. Private Sub CommandButton1_Click()
  4.     Dim sh1, sh3 As Worksheet
  5.     Dim Rng, cel As Range
  6.     Dim strR, strL As String
  7.     Dim i, j, r, blankCol, cnt(1 To 10), cnt2(1 To 10) As Integer
  8.     Dim num1, num2
  9.     num1 = Array("1", "2", "3", "4", "5", "6", "7", "8", "9")
  10.     num2 = Array("¤@", "¤G", "¤T", "¥|", "¤­", "¤»", "¤C", "¤K", "¤E")
  11.    
  12.     Set sh1 = Sheets("¿é¤J¸ê®Æ")
  13.     Set sh3 = Sheets("¤ÀÃþµ²ªG")
  14.    
  15.     '²M°£ sh3 ªº¸ê®Æ
  16.     sh3.[C3].Resize(41, 200) = ""
  17.    
  18.     '¥H§Aªº¥Ü½dÀɨӻ¡, ¿é¤J°Ï±q [A4] ¶}©lºâ, ¦@ 14¦C, 9 Äæ
  19.     '½Ð¦Û¦æ¨Ì ¹ê»Ú¿é¤J½d³ò ­×§ï Resize(14, 9) ªº¼Æ¾Ú
  20.     Set Rng = sh1.[A4].Resize(14, 9)
  21.    
  22.     For i = 1 To 10
  23.        cnt(i) = 0
  24.        cnt2(i) = 0
  25.     Next
  26.    
  27.     For Each cel In Rng
  28.    
  29.         '­Y cel ¬OªÅ­È, ´«¤U¤@­Ó
  30.         If cel.Value = "" Then GoTo next1:
  31.         
  32.         '¨ú±o³Ì¥k¤@½X
  33.         strR = Right(cel, 1)
  34.         
  35.         '¥h°£³Ì¥k¤@½X
  36.         strL = Left(cel, Len(cel) - 1)
  37.         
  38.         '¤ñ¹ï strR ¦b num1 ¤¤ ±Æ²Ä´X­Ó
  39.         j = Application.Match(strR, num1, 0)
  40.         
  41.         '­Y match ²£¥Í¿ù»~ ¡÷ ªí¥Ü strR ¤£¦b°}¦C num1 ¤¤,
  42.         If Application.IsError(j) Then
  43.         
  44.            '«hÄ~Äò¤ñ¹ï strR ¦b num2 ¤¤ ±Æ²Ä´X­Ó
  45.             j = Application.Match(strR, num2, 0)
  46.             
  47.            '­Y match ²£¥Í¿ù»~ ¡÷ ªí¥Ü strR ¤]¤£¦b°}¦C num2 ¤¤,
  48.             If Application.IsError(j) Then
  49.                
  50.                 'strR §¡¤£¦b num1¡Bnum2 ¤¤,
  51.                 '¡÷ ªí¥Ü strR À³ÂkÃþ¦b unclassified ¤¤,
  52.                 '²Î­p unclassified ªºÁ`¼Æ
  53.                 cnt(10) = cnt(10) + 1
  54.                
  55.                 '¨ú±o ªÅ¥ÕÀx¦s®æ ªº Äæ­È
  56.                 blankCol = sh3.Cells(cnt2(10) + 40, 256).End(xlToLeft).Column + 1
  57.                 If blankCol < 3 Then blankCol = 3
  58.                
  59.                 sh3.Cells(cnt2(10) + 40, blankCol) = cel
  60.                
  61.                 '­«·s­pºâ¦s¤J unclassified Ãþªº¦C­È
  62.                 cnt2(10) = cnt2(10) + 1
  63.                 If cnt2(10) >= 3 Then cnt2(10) = 0
  64.                
  65.             Else
  66.                 '²Î­p¦U²ÕªºÁ`¼Æ
  67.                 cnt(j) = cnt(j) + 1
  68.                
  69.                
  70.                 '¨ú±o ªÅ¥ÕÀx¦s®æ ªº Äæ­È
  71.                 blankCol = sh3.Cells(j * 4 + cnt2(j), 256).End(xlToLeft).Column + 1
  72.                 If blankCol < 3 Then blankCol = 3
  73.                
  74.                 sh3.Cells(j * 4 + cnt2(j), blankCol) = strL
  75.                
  76.                 '­«·s­pºâ¦s¤J ¦U²Õ ªº¦C­È
  77.                 cnt2(j) = cnt2(j) + 1
  78.                 If cnt2(j) >= 3 Then cnt2(j) = 0
  79.                
  80.             End If
  81.         Else
  82.             '²Î­p¦U²ÕªºÁ`¼Æ
  83.             cnt(j) = cnt(j) + 1
  84.                
  85.             '¨ú±o ªÅ¥ÕÀx¦s®æ ªº Äæ­È
  86.             blankCol = sh3.Cells(j * 4 + cnt2(j), 256).End(xlToLeft).Column + 1
  87.             If blankCol < 3 Then blankCol = 3
  88.                
  89.             sh3.Cells(j * 4 + cnt2(j), blankCol) = strL
  90.             
  91.             '­«·s­pºâ¦s¤J ¦U²Õ ªº¦C­È
  92.             cnt2(j) = cnt2(j) + 1
  93.             If cnt2(j) >= 3 Then cnt2(j) = 0
  94.         End If
  95.         
  96. next1:
  97.     Next
  98.    
  99.     '¶ñ¤J¦U²ÕÁ`¼Æ
  100.     For i = 1 To 10
  101.         sh3.Cells(i * 4 - 1, 3) = cnt(i)
  102.     Next
  103. End Sub
½Æ»s¥N½X
¦p¤U¹Ï:

TOP

¦^´_ 1# greetingsfromtw
¸ÉÀÉ:
¤À²Õ°ÝÃD­×§ï.7z
http://www.mediafire.com/download/gbhj146gwpj9i6d/%E5%88%86%E7%B5%84%E5%95%8F%E9%A1%8C%E4%BF%AE%E6%94%B9.7z

TOP

¤Q¤À·PÁÂyen956¤j¤jªº¼ö¤ß¨ó§U,«ÜÁÂÁ±z¦Ò¶q¨ì¤pªºÅv­­¤£¨¬,
ÁÙ¯S¦a§â³sµ²¶K¤W¨Ó,¯uªº«Ü·P°Ê.

±zªºÀɮפQ¤À¦n¥Î,¥t¥~¦³¥ó¨Æ±¡§Æ±æ¯à¸ò±z³ø§i¤@¤U,

­Y¬O¹J¨ì¯S©w²Õ§Oªº¦r¦ê¼Æ¬°µL®É,
¤ñ¦p»¡,­Y¬O©Ò¿é¤Jªº¦r¦ê¸ê®Æ¨S¦³¥ô¦ó¤@­Ó¬OÄÝ©ó²Ä¤K²Õ¸ò²Ä¤E²Õ,
´N·|²£¥Í²Ä¤K²Õ¸ò²Ä¤E²Õ¬°0ªºª¬ªp,¤£ª¾¬O§_¦³¿ìªk¯à¤£­nÅã¥Ü²Õ¼Æ¬°0ªº²Õ?
¥ç§Y,­Y¬O¦r¦ê¸ê®Æ¶È¦³²Ä¤@¨ì¤C²Õªº¸ê®Æªº¸Ü,¨º»ò²Ä¤K²Õ¸ò²Ä¤E²Õ´N¤£­nÅã¥Ü.
§ó¨ãÅé¤@ÂI´N¬O,­Y¦r¦ê¸ê®Æ¶È¦³¤@,¤T,¤»²Õªº¸Ü,¨º»ò¤G,¤­,¤C,¤K,¤E²Õ¤]¤£­nÅã¥Ü.
·íµM¨ä¹ê³o³¡¥÷ªº¸Ü¦Û¦æ¤â°Ê§R°£§Y¥i,¦ý°²³]­Y¬O¹J¨ì¤W¤d¬Æ¦Ü¬O¤W¸Uµ§¸ê®Æ,
¤S¤£¯à¥þ³¡¥´¦b¤@°_,¥²¶·¤À¦¨¦h¦¸¥h¿é¤J,¨º¥i¯àÁÙ¬O·|§Æ±æºÉ¶q±N¤H¤u³¡¥÷ÁY´î¨ì
¥u³Ñ¤Ukey inªºµ{«×³o¼Ë...

¦A¦¸·PÁ±z¤Î¦U¦ìª©¤jªº¼ö¤ß¨ó§U.

TOP

        ÀR«ä¦Û¦b : ¬°¤H³B¥@­n¤p¤ß²Ó¤ß¡A¦ý¤£­n¡u¤p¤ß²´¡v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD