[發問] 比對和標示 內容

jackyliu

目的:mapping.xls巨集程式自動讀取source.xls判斷末三碼,
符合者make為黃色.

如 :mapping.xls 開啟巨集程式自動讀取source.xls判斷末三碼,
符合者make為黃色.

1. 先讀取source.xls  A欄位所有的值,如讀取 2231-50、2234-43...
2. 再將mapping.xls 裡的 1-50、4-43  mark 成黃色
3. 附件

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

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目錄與mapping.xls相同
   
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

複製代碼

GBKEE

原先看不懂樓主的意思 依樣畫葫蘆 改用 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

複製代碼

jackyliu

感謝大大  幫忙...
可以 幫忙解惑一下好嗎?

Dim sh, fs$, s As Worksheet, mystr$, a(), C As Range
sh 有宣告什麼型態嗎?和fs$ 有關係嗎?後面 還有一個a(),這是宣告哪裡?

sh = Array("2.2", "3.0") 這裡的Array 是只陣列嗎?

Hsieh

fs$是將變數宣告為字串型態，這裡是用來當作source.xls的完整目錄字串
sh沒有宣告任何型態，所以被默認宣告為Variant
正確寫法應為Dim sh As Variant
而sh = Array("2.2", "3.0")
就指定sh的內容為一維陣列，其內容是2個數值型的字串，此處就是你的來源檔案要比對的2個工作表名稱
a()就是宣告一個陣列變數a，此陣列內容
a = .Range(.[A1], .[A65536].End(xlUp))
就是source.xls的sheets("2.2")及sheets("3.0")工作表內A欄的資料範圍的值

jackyliu

發現有些不會mark 耶...
我在source.xls 的A欄位 加入一些相關數字

再執行mapping.xls, 比對一下,資料 11筆,
卻只有mark 5個, 可以麻煩您幫我確認哪裡出問題了....

GBKEE

回復 7# jackyliu
***一個程序是按所定的條件規律來寫的 ,條件規律一改變, 就達不到你的需求****
加入一些相關數字
檔案要傳上來才知道是什麼錯??