两个工作表之间的string列的精确比较excel vba

对于某些原因IM不能评论。 下面的答案都给了我从ActiveX的各种错误无法创build对象的对象未定义。

这是我的代码。

Sub Main() Application.ScreenUpdating = False Dim stNow As String stNow = Now Set sh1 = ThisWorkbook.Worksheets("StrategyIn") Set sh2 = ThisWorkbook.Worksheets("Contractor") Dim arr As Variant arr = sh1.Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).Value Dim varr As Variant varr = sh2.Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row).Value Dim temp As Integer temp = 0 Dim x As Variant, y As Variant, Match As Boolean For Each x In arr Match = False For Each y In varr If x = y Then Match = True Next y If Not Match Then temp = temp + 1 End If Next MsgBox "Number of names that do not match = " & temp 'Debug.Print DateDiff("s", stNow, Now) Application.ScreenUpdating = True End Sub 

当我删除对其他工作表的引用以获得范围时，它工作正常，当我在一张纸上，数据全部收集在一张纸上。 有一个逻辑错误，导致我得到一些不匹配的名称= 1。感谢您的帮助！

Answer 1

希望这会为你工作。

 Sub Main() Dim match As Boolean Dim temp As Long Dim blankcount As Long Dim lastrowS As Long Dim lastrowC As Long match = False lastrowS = Worksheets("StrategyIn").Range("B" & Rows.Count).End(xlUp).Row lastrowC = Worksheets("Contractor").Range("E" & Rows.Count).End(xlUp).Row With Worksheets("StrategyIn") For i = 2 To lastrowS If .Range("B" & i).Value <> "" Then For j = 2 To lastrowC If .Range("B" & i).Value = Worksheets("Contractor").Range("E" & j).Value Then match = True End If Next j Else blankcount = blankcount + 1 End If If match = False Then temp = temp + 1 Else match = False End If Next i End With MsgBox "Number of names that do not match = " & (temp - blankcount) End Sub 

工作certificate

Answer 2

分配到匹配

 Sub Match() Dim WksS as Range, WksC as Range Dim stNow as String Dim rSI as Range, rCon as Range Dim iLR as Integer, iTemp as Variant, vVal as Variant Set WksS = Worksheets("StrategyIn") Set WksC = Worksheets("Contractor") Set rSI = WksS.Range("A2", WksS.Range("A2").End(xlDown)) Set rCon = WksC.Range("E2", WksC.Range("E2").End(xlDown)) stNow = Now() iLR = WksC.Range("A2").End(xlDown).Row '' "lastrow" iTemp = 0 '' Because is only one column you dont need to create an array For Each vVal in rCon iTemp = iTemp + IIF(Fun_Val(vVal,rCon),1,0) Next vVal iTemp = (iTemp/iLR)*100 MsgBox "Percentage difference = " & temp & "%" Exit Sub 

函数来validation

 Function Fun_Val(dVal As Double, rRange As Range) As Boolean On Error GoTo errHdlr Fun_Val = IsNumeric(Application.WorksheetFunction.Match(dVal, rRange, 0)) Exit Function errHdlr: Fun_Val = False End Function 

顺便说一句，你应该考虑改变你设置variables的方式。

1. 范围
   arr = Range("B2:B" & Range("B"&Rows.Count).End(xlUp).Row).Value
arr = Range("B2", Range("B2").End(xlDown))
2. 宣言
   Dim x, y, Match As Boolean
Dim x as Variant, y as Variant, Match As Boolean
3. 工作表
   Worksheets("StrategyIn")
   至
   Dim Wks as Worksheet
Set Wks = Worksheets("StrategyIn")
   这样你可以避免工作表之间的错误

Answer 3

您可以在Rangevariables中指定该范围正在引用的工作表。

 Sub Match() 'Call Concatenate Application.ScreenUpdating = False Dim stNow As String stNow = Now Dim arr As Range Set arr = Worksheets("StrategyIn").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value Dim varr As Range Set varr = Worksheets("Contractor").Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row).Value Dim temp As Double temp = 0 With Worksheets("StrategyIn") lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row End With Worksheets("Contractor").Select Dim x, y, Match As Boolean For Each x In arr Match = False For Each y In varr If x = y Then Match = True Next y If Not Match Then temp = temp + 1 End If Next 'temp = (temp / lastrow) * 100 MsgBox "Percentage difference = " & temp & "%" Application.ScreenUpdating = True End Sub 

Answer 4

不知道为什么你在代码中使用范围A为StrategIn 。 您可以使用.NET的Collection ArrayList来快速检查在数组中find的项目。

下面的代码将适合您的使用，没关系，如果您在两列中都有非常大的数据集。 我改变了立即窗口中的差异的最后显示，而不是像表格输出的MsgBox 。

 Option Explicit Sub ShowDifferences() Dim aColB As Variant, aColE As Variant ' Memory allocations for the range values Dim oItem As Variant Dim oListB As Object, oListE As Object, oTemp As Object ' Arraylist Objects from .NET ' Create Collections from .NET Set oListB = CreateObject("System.Collections.ArrayList") Set oListE = CreateObject("System.Collections.ArrayList") Set oTemp = CreateObject("System.Collections.ArrayList") ' Load the ranges into memory array With ThisWorkbook.Worksheets("StrategyIn") aColB = .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row).Value End With With ThisWorkbook.Worksheets("Contractor") aColE = .Range("E2:E" & .Range("E" & Rows.Count).End(xlUp).Row).Value End With ' Add these data to the ArrayList For Each oItem In aColB If Not oListB.Contains(oItem) Then oListB.Add oItem Next For Each oItem In aColE If Not oListE.Contains(oItem) Then oListE.Add oItem Next ' Free memory of Range values Set aColB = Nothing Set aColE = Nothing ' Compare the differences (different if each B not found in E) For Each oItem In oListB If Not oListE.Contains(oItem) Then oTemp.Add oItem Next ' Display the result Debug.Print "B-items", "E-items", "Differences (#Diff/#B)" Debug.Print oListB.Count, oListE.Count, oTemp.Count & Format(oTemp.Count / oListB.Count, " (0%) ") & Join(oTemp.ToArray, "|") ' CleanUp oListB.Clear oListE.Clear oTemp.Clear Set oListB = Nothing Set oListE = Nothing Set oTemp = Nothing End Sub 

Answer 5

我已经尝试了不同的解决scheme，它处理我的数据。 但我不确定这是否正是你想要的。

 Sub mismatch() Dim Lastrow_StrategyIn As Integer, temp As Integer Dim strg As Worksheet, contr As Worksheet Set strg = Worksheets("StrategyIn") Set contr = Worksheets("Contractor") Lastrow_StrategyIn = strg.Range("A65555").End(3).Row For i = 2 To Lastrow_StrategyIn strg.Cells(i, 2) = Application.IfError(Application.VLookup(strg.Cells(i, 1), contr.Range("A:A"), 1, 0), "") If strg.Cells(i, 2) = "" Then temp = temp + 1 End If Next MsgBox (temp / (Lastrow_StrategyIn - 1)) * 100 & "%" End Sub