VBA-在search重复项时不在列中重新分配新值
我正在运行VBA来search列D和列G之间的行的值的差异。我的代码工作的第一次尝试，但是当我添加更多的值（不是相同的值）的结束时，代码不似乎跟着。
Option Explicit Public Sub RateTest1() Const COLUMN_1 = "D", WS1_START = 2 Const COLUMN_2 = "G", WS2_START = 2 Dim ws1 As Worksheet, ws2 As Worksheet, col1 As Variant, col2 As Variant, tr As Long Dim max1 As Long, max2 As Long, r1 As Long, r2 As Long, red As Long, found As Boolean Dim miss As Range tr = Rows.Count: red = RGB(255, 0, 0) Set ws1 = ThisWorkbook.Sheets("Sheet1"): max1 = ws1.Cells(tr, COLUMN_1).End(xlUp).Row Set ws2 = ThisWorkbook.Sheets("Sheet1"): max2 = ws2.Cells(tr, COLUMN_2).End(xlUp).Row col1 = ws1.Range(ws1.Cells(1, COLUMN_1), ws1.Cells(max1, COLUMN_1)) col2 = ws2.Range(ws2.Cells(1, COLUMN_2), ws2.Cells(max2, COLUMN_2)) For r2 = WS2_START To max2 For r1 = WS1_START To max1 If Len(col1(r1, 1)) > 0 And col1(r1, 1) <> "N/A" Then found = (col1(r1, 1) = col2(r2, 1)) If found Then Exit For End If Next If Not found Then If miss Is Nothing Then Set miss = ws2.Cells(r2, COLUMN_2) Else Set miss = Union(miss, ws2.Cells(r2, COLUMN_2)) End If End If Next miss.Interior.Color = red For r2 = WS2_START To max2 For r1 = WS1_START To max1 If Len(col2(r2, 1)) > 0 And col1(r2, 1) <> "N/A" Then found = (col1(r2, 1) = col2(r1, 1)) If found Then Exit For End If Next If Not found Then If miss Is Nothing Then Set miss = ws2.Cells(r2, COLUMN_2) Else Set miss = Union(miss, ws2.Cells(r2, COLUMN_2)) End If End If Next miss.Interior.Color = red End Sub 如果D中的值大于G，则代码有时只能识别D和G列是不同的， “N / A”代码在那里，因为最终我想添加代码，如果列D有一个1和列G有一个“N / A” 不会突出显示。 那些被认为是相同的价值。
谢谢
这两个程序将找出两列之间的差异（非空值），除了列D中的值“1”和列G中的值“N / A”之外
Option Explicit Public Sub RateTest() Dim ws As Worksheet, miss As Range, tmp As Range, t As Double Dim max1 As Long, max2 As Long, colD As Range, colG As Range t = Timer Set ws = ThisWorkbook.Sheets("Sheet1") max1 = ws.Cells(Rows.Count, "D").End(xlUp).Row max2 = ws.Cells(Rows.Count, "G").End(xlUp).Row Set colD = ws.Range(ws.Cells(2, "D"), ws.Cells(max1, "D")) Set colG = ws.Range(ws.Cells(2, "G"), ws.Cells(max2, "G")) colD.Interior.ColorIndex = xlColorIndexNone colG.Interior.ColorIndex = xlColorIndexNone Set miss = CheckColumns(colD, colG, "N/A") If miss Is Nothing Then Set miss = CheckColumns(colG, colD, "1") Else Set tmp = CheckColumns(colG, colD, "1") If Not tmp Is Nothing Then Set miss = Union(miss, tmp) End If If Not miss Is Nothing Then miss.Interior.Color = RGB(255, 0, 0) Debug.Print "Rows: " & max1 & "; Time: " & Format(Timer - t, "0.000") & " sec" End Sub
Private Function CheckColumns(col1 As Range, col2 As Range, x As String) As Range Dim c As Variant, r As Long, d As Object, rng As Range col1.NumberFormat = "#,##0.00###" c = col1.Value2 Set d = CreateObject("Scripting.dictionary") For r = 1 To UBound(c) With col1.Cells(r) If .Errors.Item(xlNumberAsText).Value Then .Value2 = .Value2 + 0 End With d(Trim$(CStr(c(r, 1)))) = vbNullString Next c = col2.Value2 For r = 1 To UBound(c) If Len(c(r, 1)) > 0 Then If c(r, 1) <> x Then If Not d.exists(Trim(CStr(c(r, 1)))) Then If rng Is Nothing Then Set rng = col2.Cells(r) Else Set rng = Union(rng, col2.Cells(r)) End If End If End If End If Next Set CheckColumns = rng End Function
编辑以包含testing结果：
数字格式：
MS参考Cells（）。错误