Board logo

標題: [發問] 比對和標示 內容 [打印本頁]
作者: jackyliu    時間: 2011-5-7 05:13     標題: 比對和標示 內容

目的: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    時間: 2011-5-7 17:51

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    時間: 2011-5-7 18:33

  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    時間: 2011-5-7 19:46

本帖最後由 GBKEE 於 2011-5-7 19:52 編輯

原先看不懂樓主的意思 依樣畫葫蘆 改用 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    時間: 2011-5-9 20:55

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

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

sh = Array("2.2", "3.0") 這裡的Array 是只陣列嗎?
作者: Hsieh    時間: 2011-5-9 21:32

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    時間: 2011-5-10 20:16

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

再執行mapping.xls, 比對一下,資料 11筆,
卻只有mark 5個, 可以麻煩您幫我確認哪裡出問題了....
作者: GBKEE    時間: 2011-5-10 20:40

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)