比较列表并修改MSGBOX

Question

IM希望比较WB1列B中的所有条目（可以在最高300,000个）中与WB2中的主列表，Tab“ Guide”，A列A（大约500个条目）相比。

如果WB1的B列B中有新条目，则我有一个MSGBOX出现，列出了要添加到WB2中的主列表中的新类型。

如果没有发现

任何新类型的帮助，我还希望MSGBox出现“所有类型有效”，这是非常感谢的。

Sub Compare()

Dim sh1 As Worksheet
Dim sh2 As Worksheet

Dim lr1 As Long
Dim lr2 As Long

Dim rng1 As Range
Dim rng2 As Range
Dim c As Range

Dim msg As String
msg = "New types: "

Set sh1 = Sheets(1)

Workbooks.Open Filename:="filepath\Types.xls"
Set sh2 = Worksheets("Guide")

lr1 = Application.WorksheetFunction.CountA(sh1.Columns(1))
lr2 = Application.WorksheetFunction.CountA(sh2.Columns(1))

Set rng1 = sh1.Range("B2:B" & lr1)
Set rng2 = sh2.Range("A2:A" & lr2)
   
For Each c In rng1
    If Len(c.Value) > 0 And Application.CountIf(rng2, c.Value) = 0 Then
    msg = msg & vbNewLine & c.Value
    End If
    
Next

Workbooks("Types.xls").Close SaveChanges:=False

MsgBox msg

End Sub

Answer 1

您将k声明为整数，但是excel的行比整数可以处理。将所有行/列计数变量声明为long。

实际上，使用整数而不是长在VBA中没有任何好处，因此我建议始终使用long。只有一些非常罕见的情况确实需要整数：
为什么要使用integer代替长度？

---

Countif 语句是错误的，缺少标准：

If Application.WorksheetFunction.CountIf(S1.Range(S1.Cells(2, 2), S2.Cells(j, 1)), Then

应该看起来像

If Application.WorksheetFunction.CountIf(S1.Range(S1.Cells(2, 2), S2.Cells(j, 1)), CRITERIA) Then

标准需要用计数标准代替。