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

[µo°Ý] ¦h­«±ø¥ó¦¡²Î­p»P¥[Á`

[attach]790[/attach]
«D±`·PÁ«e½ú«ü¾É
µ{¦¡¥i¥H¨Ï¥Î¡C
·Q¼W¥[³æ¦ì¨C¤é¾P°â¼Æ¶qªí³æ¡A¦pABS, ORO, SHE...¡C
¬ã¨s´X¤ÑÁÙ¬OµLªk©ó«e½úµ{¦¡¤¤¼W¥[µ{¦¡¨Ó§¹¦¨¡C
¥\¤O¦³«Ý¥[±j¡]²z¸Ñ¤O¤£¨¬¡^

Set Rng = .Cells(A.row, "AM").Resize(, 7)
If Application.CountA(Rng) > 0 Then Set Rng = Rng.SpecialCells(xlCellTypeConstants) Else GoTo 10
For Each B In Rng

¤W¦Cµ{¦¡¤¤¡A¦p Reg ¤¤¥u¦³ AM, AP, AR, ASµ¥¥|Äæ¦ì¦³¸ê®Æ¡]AN. AO, AQ¤TÄæªÅ¥Õ¡^¡A
½Ð°Ý For Each B In Rng ·|°õ¦æ´X°j°é¡H

·PÁÂ

TOP

©êºpªþ¥ó¨S¦³¤W¶Ç¦¨¥\ C2.rar
C2.rar (17.39 KB)

C2.rar (17.39 KB)

TOP

¦^´_ 11# b9208


    ¦³´XÄæ¸ê®Æ´N°õ¦æ´X¦¸
ÄU§AÁÙ¬O­n¿í¦u¸ê®Æ®w³W«h»s§@¤~¯à¬Ù¥h³Â·Ð
C2.rar (23.42 KB)
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

Hsiehª©¥D
«D±`ÁÂÁ±z
µL¨p¤À¨É«ü¾É
¦]¸ê®Æ®w®æ¦¡¬O©T©wªº¡A«á¤è¥[¤Wªº毎¤é¸ê®Æ¡A
¬O¬°²Î­p¤ÀªR¥Îªº¡C
ÁÂÁÂ & ·PÁÂ

TOP

Hsieh«e½ú¡G

¥Ñ©ó¤p§Ì­è¦n¤]¦b§ä¥ÎExcel VBA¦h­«±ø¥ó¦¡²Î­pªº¤èªk¡A¦ý³o¨â¤Ñ¤~¥[¤J¡A
©Ò¥H¯à§_½ÐHsieh«e½ú¤À¨É¤@¬qµ{¦¡½X¨ÓÅý¤p§Ì°Ñ¦Ò¤@¤U¡C
·P¿E¤£ºÉ¡I

TOP

¦^´_ 15# wsx24680
  1. Private Sub CommandButton1_Click()
  2. Dim A As Range, Rng As Range, B As Range
  3. Set dc = CreateObject("Scripting.Dictionary")
  4. Set ds = CreateObject("Scripting.Dictionary")
  5. With Sheet222
  6.    For Each A In .Range(.[C7], .[C65536].End(xlUp))
  7.        mystr = Mid(A, 5, 3)
  8.        If IsError(Application.Match(mystr, Sheet201.[E10:K10], 0)) Then mystr = "Other"
  9.        Set Rng = .Cells(A.Row, "AM").Resize(, 7)
  10.        If Application.CountA(Rng) > 0 Then Set Rng = Rng.SpecialCells(xlCellTypeConstants) Else GoTo 10
  11.        For Each B In Rng
  12.        m1 = mystr & A.Offset(, 8) & B
  13.        m2 = mystr & B & B.Offset(, 7)
  14.        m3 = mystr & A.Offset(, 8) & .Cells(5, B.Column) & B
  15.        dc(m1) = dc(m1) + 1
  16.        dc(m2) = dc(m2) + 1
  17.        ds(m1) = ds(m1) + B.Offset(, 14)
  18.        ds(m3) = ds(m3) + B.Offset(, 14)
  19.        Next
  20. 10
  21.    Next
  22. End With
  23. With Sheet201
  24.    Set Rng = .Columns("C").SpecialCells(xlCellTypeConstants)
  25.    For Each A In Rng
  26.    If A = "¾P°â¥[Á`¼Æ¶q" Then yn = True
  27.    If InStr(A, "¨C¤é¾P°â¼Æ¶q") > 0 Then mystr1 = Mid(A, 1, 3)
  28.        If A.MergeCells = False Then
  29.        If A.Row < 47 Then
  30.           For Each B In .[E10:K10]
  31.               mystr = B & A & A.Offset(, 1)
  32.               If yn = True Then .Cells(A.Row, B.Column) = ds(mystr) Else .Cells(A.Row, B.Column) = dc(mystr)
  33.           Next
  34.         Else
  35.           For Each B In .[E48:K48]
  36.               mystr = mystr1 & A & B & A.Offset(, 1)
  37.               .Cells(A.Row, B.Column) = ds(mystr)
  38.           Next
  39.         End If
  40.         End If
  41.     Next
  42. End With
  43. Set dc = Nothing
  44. Set ds = Nothing
  45. MsgBox ("®¥³ß±z~²Î­p§¹¦¨!!")   'µ²§ôµøµ¡´£¥Ü
  46. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

·PÁ Hsiehª©¥Dªº¤À¨É¡A¬Ý¨Ób9208¤j ªº¸ê®Æ¤º®e½T¹ê¦³ÂI½ÆÂø

TOP

        ÀR«ä¦Û¦b : ¬Ý§O¤H¤£¶¶²´¡A¬O¦Û¤v­×¾i¤£°÷¡C
ªð¦^¦Cªí ¤W¤@¥DÃD