[µo°Ý] ¤ñ¹ï©M¼Ð¥Ü ¤º®e

jackyliu

¥Øªº:mapping.xls¥¨¶°µ{¦¡¦Û°ÊŪ¨úsource.xls§PÂ_¥½¤T½X,
²Å¦XªÌmake¬°¶À¦â.

¦p :mapping.xls ¶}±Ò¥¨¶°µ{¦¡¦Û°ÊŪ¨úsource.xls§PÂ_¥½¤T½X,
²Å¦XªÌmake¬°¶À¦â.

1. ¥ýŪ¨úsource.xls  AÄæ¦ì©Ò¦³ªº­È,¦pŪ¨ú 2231-50¡B2234-43...
2. ¦A±Nmapping.xls ¸Ìªº 1-50¡B4-43  mark ¦¨¶À¦â
3. ªþ¥ó

GBKEE

¦^´_ 7# jackyliu
***¤@­Óµ{§Ç¬O«ö©Ò©wªº±ø¥ó³W«ß¨Ó¼gªº ,±ø¥ó³W«ß¤@§ïÅÜ, ´N¹F¤£¨ì§Aªº»Ý¨D****
¥[¤J¤@¨Ç¬ÛÃö¼Æ¦r
ÀÉ®×­n¶Ç¤W¨Ó¤~ª¾¹D¬O¤°»ò¿ù??

jackyliu

µo²{¦³¨Ç¤£·|mark ­C...
§Ú¦bsource.xls ªºAÄæ¦ì ¥[¤J¤@¨Ç¬ÛÃö¼Æ¦r

¦A°õ¦æmapping.xls, ¤ñ¹ï¤@¤U,¸ê®Æ 11µ§,
«o¥u¦³mark 5­Ó, ¥i¥H³Â·Ð±zÀ°§Ú½T»{­þ¸Ì¥X°ÝÃD¤F....

Hsieh

fs$¬O±NÅܼƫŧi¬°¦r¦ê«¬ºA¡A³o¸Ì¬O¥Î¨Ó·í§@source.xlsªº§¹¾ã¥Ø¿ý¦r¦ê
sh¨S¦³«Å§i¥ô¦ó«¬ºA¡A©Ò¥H³QÀq»{«Å§i¬°Variant
¥¿½T¼gªkÀ³¬°Dim sh As Variant
¦Ósh = Array("2.2", "3.0")
´N«ü©wshªº¤º®e¬°¤@ºû°}¦C¡A¨ä¤º®e¬O2­Ó¼Æ­È«¬ªº¦r¦ê¡A¦¹³B´N¬O§Aªº¨Ó·½ÀÉ®×­n¤ñ¹ïªº2­Ó¤u§@ªí¦WºÙ
a()´N¬O«Å§i¤@­Ó°}¦CÅܼÆa¡A¦¹°}¦C¤º®e
a = .Range(.[A1], .[A65536].End(xlUp))
´N¬Osource.xlsªºsheets("2.2")¤Îsheets("3.0")¤u§@ªí¤ºAÄ檺¸ê®Æ½d³òªº­È

jackyliu

·PÁ¤j¤j  À°¦£...
¥i¥H À°¦£¸Ñ´b¤@¤U¦n¶Ü?

Dim sh, fs$, s As Worksheet, mystr$, a(), C As Range
sh ¦³«Å§i¤°»ò«¬ºA¶Ü?©Mfs$ ¦³Ãö«Y¶Ü?«á­± ÁÙ¦³¤@­Óa(),³o¬O«Å§i­þ¸Ì?

sh = Array("2.2", "3.0") ³o¸ÌªºArray ¬O¥u°}¦C¶Ü?

GBKEE

­ì¥ý¬Ý¤£À´¼Ó¥Dªº·N«ä ¨Ì¼Ëµe¸¬Äª §ï¥Î Application.Match ¤ñ¹ï

1. Sub Ex()
   
2.     Dim Fs$, Sh As Worksheet, R As Range, AR()
   
3.     Fs = ThisWorkbook.Path & "\source.xls"
   
4.     ReDim AR(0)
   
5.     With Workbooks.Open(Fs)
   
6.         For Each Sh In .Sheets
   
7.             For Each R In Sh.UsedRange
   
8.                 If IsError(Application.Match(Right(R, 4), AR, 0)) And R <> "" Then
   
9.                     AR(UBound(AR)) = Right(R, 4)
   
10.                     ReDim Preserve AR(UBound(AR) + 1)
    
11.                 End If
    
12.             Next
    
13.         Next
    
14.         .Close 0
    
15.     End With
    
16.     With Me
    
17.         For Each Sh In .Sheets
    
18.             Sh.UsedRange.Interior.ColorIndex = -4142
    
19.             For Each R In Sh.UsedRange
    
20.                 If IsError(Application.Match(Right(R, 4), AR, 0)) = False And R <> "" Then
    
21.                     R.Interior.ColorIndex = 6
    
22.                 End If
    
23.             Next
    
24.         Next
    
25.     End With
    
26. End Sub

½Æ»s¥N½X

Hsieh

1. Private Sub Workbook_Open()
   
2. Dim sh, fs$, s As Worksheet, mystr$, a(), C As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. fs = ThisWorkbook.Path & "\source.xls" 'source.xls¥Ø¿ý»Pmapping.xls¬Û¦P
   
5. sh = Array("2.2", "3.0")
   
6. With Workbooks.Open(fs)
   
7.    For Each s In .Sheets(sh)
   
8.       With s
   
9.         a = .Range(.[A1], .[A65536].End(xlUp))
   
10.         For i = 1 To UBound(a)
    
11.            mystr = .Name & Right(a(i, 1), 4)
    
12.            d(mystr) = d.Count
    
13.         Next
    
14.       End With
    
15.    Next
    
16. .Close
    
17. End With
    
18. With Me
    
19.    For Each s In .Sheets(sh)
    
20.    s.UsedRange.Interior.ColorIndex = -4142
    
21.       For Each C In s.UsedRange
    
22.          If d.exists(s.Name & C) Then C.Interior.ColorIndex = 6
    
23.       Next
    
24.    Next
    
25. End With
    
26. End Sub

½Æ»s¥N½X

et5323

Sub myColor(xlSht As Worksheet)
    Dim oDic As Object, xlWk As Object
    Dim arr, i, r As Range
    Application.ScreenUpdating = False
    Set xlWk = GetObject(ThisWorkbook.Path & "\source.xls")
    With xlWk
        With .Sheets(xlSht.Name)
            arr = .Range("a1:a" & .[a65536].End(xlUp).Row)
        End With
        .Close False
    End With
   
    Set oDic = CreateObject("scripting.dictionary")
    For i = 1 To UBound(arr)
        oDic(Right(arr(i, 1), 4)) = ""
    Next
    xlSht.UsedRange.Interior.ColorIndex = xlNone
    For Each r In xlSht.UsedRange
        With r
            If oDic.exists(.Value) Then .Interior.Color = RGB(255, 255, 0)
        End With
    Next
    Application.ScreenUpdating = True
End Sub

Sub test()
    myColor Sheets("2.2")
    'myColor Sheets("3.0")
End Sub