¦h­«Äæ¦ìÀˬd

lai.k.h

¦U¦ì¦Ñ®v¦pªþÀɤº½d¨Ò¤Î»¡©ú¡A¦]¹ê¦b¤£¬O¯u¥¿«ÜÁA¸ÑDictionary¤ÎArrayªº¥Îªk¡A·Q¤F«Ü¤[ÁÙ¬OµLªk§Q¥ÎVBAµ{¦¡§¹¦¨¡A©Ò¥HÀµ½Ð¦U¦ì¦Ñ®v¯à«ü¾É¤p§Ì¤@¤U¡A·PÁ¡C

FAlonso

¬ãŪ¤FH¤jªºµ{¦¡
26-32¦æ§âar©Mxxx(mystr)¤¬½Õªº§âÀ¸¯u¬O¼F®`

lai.k.h

ÁÂÁÂ~§V¤O®ø¤Æ¤¤

Hsieh

¦^´_ 5# lai.k.h

1. Sub ¦h­«Äæ¦ìÀˬd()
   
2. Dim A As Range, Mystr$, Ar(), ErrStr()
   
3. Set ¶}©l = CreateObject("Scripting.Dictionary")
   
4. Set µ²§ô = CreateObject("Scripting.Dictionary")
   
5. Set ¬P´Á = CreateObject("Scripting.Dictionary")
   
6. Set ¤é´Á = CreateObject("Scripting.Dictionary")
   
7. Set §Ç¸¹ = CreateObject("Scripting.Dictionary")
   
8. 
   
9. With Sheet1
   
10. .[D3:Q65536].Interior.ColorIndex = 0 'D~QÄæÃC¦â²M°£
    
11. For Each A In .Range(.[D3], .[D65536].End(xlUp)) 'D3¶}©l°µ°j°é
    
12. x = 0
    
13.     Mystr = Join(Application.Transpose(Application.Transpose(A.Resize(, 3))), Chr(10)) '¥Î¸õ¦æ¦r¤¸³s±µD~F¤º®e§@¯Á¤Þ¦r¦ê
    
14.     ¶}©l(Mystr) = Mid(Split(A.Offset(, 1), "-")(0), 3) 'EÄæ¸ê®Æ¥H-¤À³Î¦¨2³¡¤À¡A²Ä1³¡¤À²Ä3½X¶}©l¬°¶}©l¤é´Á
    
15.     µ²§ô(Mystr) = Split(A.Offset(, 1), "-")(1) 'EÄæ¸ê®Æ¥H-¤À³Î¦¨2³¡¤À¡A²Ä2³¡¤À¬°µ²§ô¤é´Á
    
16.     'DÄæ¦V¥k6Ä檺¦ì¸m¦pªG¤£µ¥©ó¶}©l¤é´Á´N§ïÅÜÃC¦â¡A¨Ã±N¿ù»~¤å¦r¦s¤J°}¦C
    
17.     If Format(A.Offset(, 6), "yyyymmdd") <> ¶}©l(Mystr) Then A.Offset(, 6).Interior.ColorIndex = 36: ReDim Preserve ErrStr(x): ErrStr(x) = "¶}©l¤é´Á¿ù»~": x = x + 1
    
18.     'DÄæ¦V¥k7Ä檺¦ì¸m¦pªG¤£µ¥©óµ²§ô¤é´Á´N§ïÅÜÃC¦â¡A¨Ã±N¿ù»~¤å¦r¦s¤J°}¦C
    
19.     If Format(A.Offset(, 7), "yyyymmdd") <> µ²§ô(Mystr) Then A.Offset(, 7).Interior.ColorIndex = 36:  ReDim Preserve ErrStr(x): ErrStr(x) = "µ²§ô¤é´Á¿ù»~": x = x + 1
    
20.    
    
21.     If IsEmpty(¬P´Á(Mystr)) Then '¦pªG¥HMystr¬°¯Á¤Þªº¬P´Á¬Oªì©l­È
    
22.        ¬P´Á(Mystr) = A.Offset(, 8) '¬ö¿ýDÄæ¦V¥k8Ä檺­È
    
23.        ElseIf A.Offset(, 8) <> ¬P´Á(Mystr) Then '§_«h´N¸ò¤w¦sªº­È¤ñ¸û¡A¦pªG¤£¦P
    
24.        'DÄæ¦V¥k8ÄæÅܦâ¡A¨Ã±N¿ù»~¤å¦r¦s¤J°}¦C
    
25.        A.Offset(, 8).Interior.ColorIndex = 36:  ReDim Preserve ErrStr(x): ErrStr(x) = "«ô³X¬P´Á´Á¿ù»~": x = x + 1
    
26.     End If
    
27.     If IsEmpty(¤é´Á(Mystr)) Then '¦pªG¥HMystr¬°¯Á¤Þªº¤é´Á¬Oªì©l­È
    
28.     ReDim Preserve Ar(0) '¥¬¸m¤@­Ó¥u¦³1­Ó¤¸¯Àªº°}¦C
    
29.     Ar(0) = A.Offset(, 9) '¦¹°}¦C²Ä1­Ó¤¸¯À­È¬ODÄæ¦V¥k9Ä檺­È
    
30.        ¤é´Á(Mystr) = Ar '§â°}¦C§@¬°¦r¨åª«¥ó¤º®e
    
31.        ElseIf IsError(Application.Match(A.Offset(, 9), ¤é´Á(Mystr), 0)) Then '¦pªGDÄæ¦V¥k9Ä檺­È¦b¦r¨åª«¥ó(¦¹³B·|¬O¤@­Ó°}¦C)¤º§ä¤£¨ì
    
32.        Ar = ¤é´Á(Mystr) '¥ý¨ú¥X¦r¨åª«¥ó¤º®e¶Çµ¹°}¦CÅܼÆ
    
33.        s = UBound(Ar) + 1 '¬ö¿ý°}¦C¤W­­­È(ÂX¥R°}¦C)
    
34.        ReDim Preserve Ar(s) '°}¦C·s¤¸¯À
    
35.        Ar(s) = A.Offset(, 9)
    
36.        ¤é´Á(Mystr) = Ar '±N¥HÂX¤jªº°}¦C¶Ç¦^¦r¨åª«¥ó
    
37.        Else '§_«h(¤é´Á¤w¸g¦s¦b)
    
38.        'DÄæ¦V¥k9ÄæÅܦâ¡A¨Ã±N¿ù»~¤å¦r¦s¤J°}¦C
    
39.        A.Offset(, 9).Interior.ColorIndex = 36: ReDim Preserve ErrStr(x): ErrStr(x) = "«ô³X¤é´Á­«½Æ": x = x + 1
    
40.     End If
    
41.     '§Ç¸¹°µªk»P¤é´Á¬Û¦P¡A¤£¦A²Ö­z
    
42.     If IsEmpty(§Ç¸¹(Mystr)) Then
    
43.     ReDim Preserve Ar(0)
    
44.     Ar(0) = A.Offset(, 12)
    
45.        §Ç¸¹(Mystr) = Ar
    
46.        ElseIf IsError(Application.Match(A.Offset(, 12), §Ç¸¹(Mystr), 0)) Then
    
47.        Ar = §Ç¸¹(Mystr)
    
48.        s = UBound(Ar) + 1
    
49.        ReDim Preserve Ar(s)
    
50.        Ar(s) = A.Offset(, 12)
    
51.        §Ç¸¹(Mystr) = Ar
    
52.        Else
    
53.        A.Offset(, 12).Interior.ColorIndex = 36: ReDim Preserve ErrStr(x): ErrStr(x) = "§Ç¸¹­«½Æ": x = x + 1
    
54.     End If
    
55.     '¦pªG¿ù»~¦r¦ê°}¦C¤¸¯À¼Æ¶q¤£µ¥©ó0¡A´Nªí¥Ü¦³¿ù»~¡ADÄæ¦V¥k13ÄæÅܦâ¡A¨Ã¼g¤J¥H\³s±µªº¿ù»~¤å¦r¡A§_«h´N²M°£
    
56.    If x > 0 Then A.Offset(, 13).Interior.ColorIndex = 35: A.Offset(, 13) = Join(ErrStr, "\") Else A.Offset(, 13) = ""
    
57. Erase ErrStr '¿ù»~¦r¦êªº°}¦C²MªÅ
    
58. Next
    
59. End With
    
60. End Sub

½Æ»s¥N½X

lai.k.h

·PÁÂHsieh¦Ñ®vªº¦^ÂСA¸g¹L´ú¸Õ«á¤w§¹¥þ¨S°ÝÃD¡AÁö¥H¥Ø«e§Úªºµ{«×¨Ó»¡­n§¹¥þÁA¸Ñ¹êÄݧxÃø¡A¦ý§ÚÁÙ¬O·|§V¤O¾Ç²ßªº¡A¤]§Æ±æ­Y±z¦³ªÅ¥i§_¥[µù»¡©ú¡AÅý§Ú¯à§ó¥[²M·¡¨ä¤º®e¡A¦A¦¸·PÁ±z¡C

Hsieh

¦^´_ 3# lai.k.h

1. Sub ¦h­«Äæ¦ìÀˬd()
   
2. Dim A As Range, Mystr$, Ar(), ErrStr()
   
3. Set ¶}©l = CreateObject("Scripting.Dictionary")
   
4. Set µ²§ô = CreateObject("Scripting.Dictionary")
   
5. Set ¬P´Á = CreateObject("Scripting.Dictionary")
   
6. Set ¤é´Á = CreateObject("Scripting.Dictionary")
   
7. Set §Ç¸¹ = CreateObject("Scripting.Dictionary")
   
8. 
   
9. With Sheet1
   
10. .[D3:Q65536].Interior.ColorIndex = 0
    
11. For Each A In .Range(.[D3], .[D65536].End(xlUp))
    
12. x = 0
    
13.     Mystr = Join(Application.Transpose(Application.Transpose(A.Resize(, 3))), Chr(10))
    
14.     ¶}©l(Mystr) = Mid(Split(A.Offset(, 1), "-")(0), 3)
    
15.     µ²§ô(Mystr) = Split(A.Offset(, 1), "-")(1)
    
16.     If Format(A.Offset(, 6), "yyyymmdd") <> ¶}©l(Mystr) Then A.Offset(, 6).Interior.ColorIndex = 36: ReDim Preserve ErrStr(x): ErrStr(x) = "¶}©l¤é´Á¿ù»~": x = x + 1
    
17.     If Format(A.Offset(, 7), "yyyymmdd") <> µ²§ô(Mystr) Then A.Offset(, 7).Interior.ColorIndex = 36:  ReDim Preserve ErrStr(x): ErrStr(x) = "µ²§ô¤é´Á¿ù»~": x = x + 1
    
18.     If IsEmpty(¬P´Á(Mystr)) Then
    
19.        ¬P´Á(Mystr) = A.Offset(, 8)
    
20.        ElseIf A.Offset(, 8) <> ¬P´Á(Mystr) Then
    
21.        A.Offset(, 8).Interior.ColorIndex = 36:  ReDim Preserve ErrStr(x): ErrStr(x) = "«ô³X¬P´Á´Á¿ù»~": x = x + 1
    
22.     End If
    
23.     If IsEmpty(¤é´Á(Mystr)) Then
    
24.     ReDim Preserve Ar(0)
    
25.     Ar(0) = A.Offset(, 9)
    
26.        ¤é´Á(Mystr) = Ar
    
27.        ElseIf IsError(Application.Match(A.Offset(, 9), ¤é´Á(Mystr), 0)) Then
    
28.        Ar = ¤é´Á(Mystr)
    
29.        s = UBound(Ar) + 1
    
30.        ReDim Preserve Ar(s)
    
31.        Ar(s) = A.Offset(, 9)
    
32.        ¤é´Á(Mystr) = Ar
    
33.        Else
    
34.        A.Offset(, 9).Interior.ColorIndex = 36: ReDim Preserve ErrStr(x): ErrStr(x) = "«ô³X¤é´Á­«½Æ": x = x + 1
    
35.     End If
    
36.    
    
37.     If IsEmpty(§Ç¸¹(Mystr)) Then
    
38.     ReDim Preserve Ar(0)
    
39.     Ar(0) = A.Offset(, 12)
    
40.        §Ç¸¹(Mystr) = Ar
    
41.        ElseIf IsError(Application.Match(A.Offset(, 12), §Ç¸¹(Mystr), 0)) Then
    
42.        Ar = §Ç¸¹(Mystr)
    
43.        s = UBound(Ar) + 1
    
44.        ReDim Preserve Ar(s)
    
45.        Ar(s) = A.Offset(, 12)
    
46.        §Ç¸¹(Mystr) = Ar
    
47.        Else
    
48.        A.Offset(, 12).Interior.ColorIndex = 36: ReDim Preserve ErrStr(x): ErrStr(x) = "§Ç¸¹­«½Æ": x = x + 1
    
49.     End If
    
50.    If x > 0 Then A.Offset(, 13).Interior.ColorIndex = 35: A.Offset(, 13) = Join(ErrStr, "\") Else A.Offset(, 13) = ""
    
51. Erase ErrStr
    
52. Next
    
53. End With
    
54. End Sub

½Æ»s¥N½X

¦h­«Äæ¦ìÀˬd.rar (31.48 KB)

¤U¸ü¦¸¼Æ: 11

2011-3-3 16:31

lai.k.h

«D±`·PÁÂHsieh¦Ñ®vªº¦^ÂСA¦ý¬O¸g¹L¹ê»ÚRun¹L«á¡Aµo²{¦b¨Cµ§§Ç¸¹12ªº¦ì¸m¬Ò·|¥X²{§Ç¸¹­«ÂЪº¼Ð¥Ü(¦pªþ¥ó)¡A¤£ª¾¬O¨º¸Ìµo¥Í°ÝÃD¡A¥t¥~­Y´¡¤J¨ä¥LÄæ¦ì¦pªþ¥ó¤¤ªºG,H,I,N,O¤­Äæ¡A¦ý¦¹¤­Äæ¬Ò¤£°µ¥ô¦óªº¤ñ¹ïªº¸Ü¡A¬O§_ª½±µ­×§ïOffset­È§Y¥i¡C

Hsieh

¦^´_ 1# lai.k.h

1. Sub nn()
   
2. Dim A As Range, ErrStr$
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. Set d2 = CreateObject("Scripting.Dictionary")
   
6. Set dic3 = CreateObject("Scripting.Dictionary")
   
7. [D3:L65536].Interior.ColorIndex = 0
   
8. For Each A In Range([D3], [D65536].End(xlUp))
   
9.     mystr = Join(Array(A, A.Offset(, 1).Value, A.Offset(, 2).Value), Chr(10))
   
10.     If d.exists(mystr) = False Then d(mystr) = mystr: d1(mystr) = A.Offset(, 5).Value
    
11.     If InStr(d2(mystr), A.Offset(, 6).Text) > 0 Then A.Offset(, 6).Interior.ColorIndex = 36: ErrStr = ErrStr & "«ô³X¤é´Á­«ÂÐ"
    
12.     d2(mystr) = d2(mystr) & A.Offset(, 6).Text
    
13.     If InStr(dic3(mystr), A.Offset(, 7).Text) > 0 Then A.Offset(, 7).Interior.ColorIndex = 36: ErrStr = ErrStr & "§Ç¸¹­«½Æ"
    
14.     dic3(mystr) = dic3(mystr) & A.Offset(, 7).Text
    
15.     If InStr(d(mystr), Format(A.Offset(, 3), "yyyymmdd")) = 0 Then A.Offset(, 3).Interior.ColorIndex = 36: ErrStr = ErrStr & "¶g´Á¶}©l¿ù»~"
    
16.     If InStr(d(mystr), Format(A.Offset(, 4), "yyyymmdd")) = 0 Then A.Offset(, 4).Interior.ColorIndex = 36: ErrStr = ErrStr & "µ²§ô®É¶¡¿ù»~"
    
17.     If A.Offset(, 5).Value <> d1(mystr) Then A.Offset(, 5).Interior.ColorIndex = 36: ErrStr = ErrStr & "«ô³X¬P´Á¿ù»~"
    
18.     If ErrStr <> "" Then A.Offset(, 8) = ErrStr: A.Offset(, 8).Interior.ColorIndex = 35
    
19.     ErrStr = ""
    
20. Next
    
21. End Sub

½Æ»s¥N½X