如何比较用户选择 excel VBA 中的 2 个工作表列？

Question

我正在尝试比较 2 个工作表，并且我有以下代码对我有用，但它有点慢，而且我无法获得一个对话框来允许用户从两个工作表中选择比较源我无法让它选择输出结果的列。一切都在代码中完成，但需要它在 excel 前台更灵活，而不是一直编辑代码以查找数据源。第一个 sub 将 sheet1 与 sheet2 进行比较，并将结果写入表格末尾的 sheet 1。第二个 sub 将对 sheet2 与 sheet1 进行相反的比较，并将结果写入表末尾的 sheet2 中。任何有关如何实现上述目标的帮助或指导将不胜感激。

Sub sample1()

Dim i, lastRow, currentRow As Long
Dim foundMatch As Range
Dim srcCriteria As String

Dim wsDest As Worksheet
Dim wsSrc As Worksheet

Set wsDest = ActiveWorkbook.Sheets("Sheet1")
Set wsSrc = ActiveWorkbook.Sheets("Sheet2")

lastRow = wsDest.Range("J" & Rows.Count).End(xlUp).Row

For i = 2 To lastRow
    srcCriteria = wsDest.Range("J" & i).value
    With wsSrc
    Set foundMatch = .Columns(3).Find(What:=srcCriteria, After:=.Cells(1, 3), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)  'finds a match
    End With
If foundMatch Is Nothing Then
    wsDest.Range("S" & i).value = "0"
Else
With wsSrc
    currentRow = .Columns(3).Find(What:=srcCriteria, After:=.Cells(1, 3), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
    End With
    wsDest.Range("S" & i).value = wsSrc.Range("I" & currentRow).value

 End If
Next i


End Sub

Sub sample2()

Dim i, lastRow, currentRow As Long
Dim foundMatch As Range
Dim srcCriteria As String

Dim wsDest As Worksheet
Dim wsSrc As Worksheet

Set wsDest = ActiveWorkbook.Sheets("Sheet1")
Set wsSrc = ActiveWorkbook.Sheets("Sheet2")

lastRow = wsSrc.Range("C" & Rows.Count).End(xlUp).Row


For i = 2 To lastRow
    srcCriteria = wsSrc.Range("C" & i).value

    With wsDest
    Set foundMatch = .Columns(10).Find(What:=srcCriteria, After:=.Cells(1, 10), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)  'finds a match
    End With

If foundMatch Is Nothing Then
    wsSrc.Range("M" & i).value = "To remove"

Else
With wsDest
    currentRow = .Columns(10).Find(What:=srcCriteria, After:=.Cells(1, 10), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
    End With

    wsSrc.Range("M" & i).value = wsDest.Range("L" & currentRow).value

 End If
Next i


End Sub

Answer 1

如果你想加快你的代码速度，那么有几个速战速决

Application.ScreenUpdating=false
Application.Calculation = xlCalculationMannual

这将停止屏幕更新并停止所有计算，只需记住在 sub 结束时重新打开 calc

Application.Calculation = xlCalculationAutomatic

至于第二个问题，最简单的方法是输入工作表名称

Dim sht1 As String, sht2 As String

sht1 = Application.InputBox("please input your first sheets name")
sht2 = Application.InputBox("please input your second sheets name")
Set wsDest = ActiveWorkbook.Sheets(sht1)
Set wsSrc = ActiveWorkbook.Sheets(sht2)

或者您可以使用输入框在每个工作表中选择一个单元格并使用它来获取工作表名称

Dim sht1 As String, sht2 As String
Dim rng1 As Range, rng2 As Range

Set rng1 = Application.InputBox("Select cell in your first sheet:", Type:=8)
Set rng2 = Application.InputBox("Select cell in your second sheet:", Type:=8)
sht1 = rng1.Parent.Name
sht2 = rng2.Parent.Name
Set wsDest = ActiveWorkbook.Sheets("sht1")
Set wsSrc = ActiveWorkbook.Sheets("sht2")

如果你想选择你的范围使用

Set rng1 = Application.InputBox("Select your first range:", Type:=8)
    Set rng2 = Application.InputBox("Select your second range:", Type:=8)

LastRow = rng1.Rows.Count

For i = 2 To LastRow
    srcCriteria = rng1(10 & i).Value 'column 10 = j