Question

我正在尝试比较2个工作表，我有以下代码对我有用，但它有点慢，我也无法得到一个对话框，允许用户从两个工作表中选择比较来源我无法让它选择输出结果的列。所有这些都是在代码中完成的，但需要它在excel前面更灵活，而不是编辑代码在哪里找到数据源。 First sub将sheet1与sheet2进行比较，并将结果写在表格末尾的表1中。第二个子将对照sheet1对比sheet2并将结果写在表格末尾的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重新打开。

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

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

1 个答案: