Question

我有Sheet1和Sheet2。我想在Test Code 1中找到标题Sheet1，在Sheet2中找到相同的标题。之后，我要检查Test Code 1中Sheet1下的每个数字，并将其与Test Code 1中Sheet2下的数字进行比较。如果数字相同，我想将单元格复制到Sheet2中的相应单元格中。由于我想更改代码以进一步使用，因此它必须像下面显示的那样使用Find函数和一个循环来工作。

Sub CompareV1()

Dim FindT1 As Range
Dim FindT2 As Range

Dim Values1 As Range
Dim Values2 As Range

Dim T1Column As Long
Dim T1Row As Long

Dim T2Column As Long
Dim T2Row As Long

Dim V1Column As Long
Dim V1Row As Long

Dim V2Column As Long
Dim V2Row As Long

Dim x As Long
Dim y As Long

    With Sheets("Sheet1").Range("A:FF")

        Set FindT1 = .Find(What:="Test Code 1", LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False)
        Set Values1 = .Find(What:="Values", LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False)

    End With

    With Sheets("Sheet2").Range("A:FF")

        Set FindT2 = .Find(What:="Test Code 1", LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False)
        Set Values2 = .Find(What:="Values", LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False)

    End With

    With Sheets("Sheet2").Range("A:FF")

        If Not FindT2 Is Nothing Then

        For x = 1 To 10

        T1Row = FindT1.Row + x
        T1Column = FindT1.Column

        T2Row = FindT2.Row + x
        T2Column = FindT2.Column

        V1Row = Values1.Row + x
        V1Column = Values1.Column

        V2Row = Values2.Row + x
        V2Column = Values2.Column

        If FindT1.Value = FindT2.Value Then

        Set Values1 = Sheets("Sheet1").Cells(V1Row, V1Column)
        Set Values2 = Sheets("Sheet2").Cells(V2Row, V2Column)

        Values1.Copy Values2

        Else

        End If

        Next x

        Else

        End If

    End With

End Sub

由于某种原因，它无法正常工作。我不知道为什么当前结果如下：

Answer 1

我认为这是因为您正在if语句中比较标头，确实增加了T1Row和T2Column以步进到值中，但是在代码到达那里时，您没有更新FindT1的值我认为它仍然指向标题，因此它被调整了一个。我将if语句更改为：

if cells(T1Row, T1Column).value = cells(T2Row, T2Column).value Then

通过评论者正确的方式-可以大大简化：

    Dim orig_val As Variant
    Dim check_val As Variant

    For x = 1 To 10
        orig_val = Sheets("Sheet1").Cells(FindT1.Row + x, FindT1.Column).Value
        check_val = Sheets("Sheet2").Cells(FindT1.Row + x, FindT1.Column).Value
        If orig_val = check_val Then
            Sheets("Sheet2").Cells(Values2.Row + x, Values2.Column).Value = orig_val
        End If
    Next x

Answer 2

您可以尝试：

Option Explicit

Sub TEST()

    Dim arr1 As Variant, arr2 As Variant
    Dim LastRow1 As Long, LastRow2 As Long, i As Long, j As Long
    Dim rngFound1 As Range, rngFound2 As Range
    Dim strSearch As String
    Dim ws1 As Worksheet, ws2 As Worksheet

    With ThisWorkbook
        Set ws1 = .Worksheets("Sheet1")
        Set ws2 = .Worksheets("Sheet2")
    End With

    strSearch = "Test Code 1"

    Set rngFound1 = ws1.UsedRange.Find(What:=strSearch, LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False)
    Set rngFound2 = ws2.UsedRange.Find(What:=strSearch, LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False)

    If Not rngFound1 Is Nothing And Not rngFound2 Is Nothing Then

        With ws1
            LastRow1 = .Cells(.Rows.Count, rngFound1.Column).End(xlUp).Row
            arr1 = .Range(.Cells(rngFound1.Row + 1, rngFound1.Column), .Cells(LastRow1, rngFound1.Column))
        End With

        With ws2
            LastRow2 = .Cells(.Rows.Count, rngFound2.Column).End(xlUp).Row
            arr2 = .Range(.Cells(rngFound2.Row + 1, rngFound2.Column), .Cells(LastRow2, rngFound2.Column))
        End With

        For i = LBound(arr1) To UBound(arr1)

            For j = LBound(arr2) To UBound(arr2)

                If arr1(i, 1) = arr2(j, 1) Then
                    ws2.Cells(rngFound2.Row + j, rngFound2.Column + 1).Value = ws1.Cells(rngFound1.Row + i, rngFound1.Column + 1).Value
                    Exit For
                End If

            Next j

        Next i

    Else

        MsgBox "Sheet1 or Sheet2 or both does/do not includes/include " & strSearch

    End If

End Sub

比较单元格后查找，复制和粘贴值

2 个答案: