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

¦h­«Äæ¦ìÀˬd

¦h­«Äæ¦ìÀˬd

¦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

¦h­«Äæ¦ìÀˬd.zip (5.3 KB)

¦^´_ 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
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

«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

¦h­«Äæ¦ìÀˬd1.zip (64.38 KB)

TOP

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

TOP

·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

TOP

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

TOP

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

TOP

¥»©«³Ì«á¥Ñ FAlonso ©ó 2011-3-8 22:32 ½s¿è

¬ãŪ¤FH¤jªºµ{¦¡
26-32¦æ§âar©Mxxx(mystr)¤¬½Õªº§âÀ¸¯u¬O¼F®`
80 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

        ÀR«ä¦Û¦b : ­×¦æ­nô½t­×¤ß¡AÂǨƽm¤ß¡AÀH³B¾i¤ß¡C
ªð¦^¦Cªí ¤W¤@¥DÃD