Question

使用Excel VBA，我需要查看一个工作簿中的列C＆＃34; A＆＃34;并将数据与列＆＃34; B＆＃34;进行比较在工作簿＆＃34; B＆＃34;。如果找到匹配，则复制来自单元格的数据＆＃34; G：I＆＃34;工作簿＆＃34; B＆＃34;在同一行中进行匹配并将数据粘贴到单元格中：M：O＆＃34;工作簿＆＃34; A＆＃34;在同一排比赛中。

这是我提出的宏，它找到匹配但不会复制值。使用手表我确认了比赛。

感谢您的帮助！

Sub update()

    Dim filename As String
    Dim filedate As String
    Dim filepath As String
    Dim folderyear As String
    Dim i As Double
    Dim j As Double
    Dim LastRow As Range
    Dim TargetLastRow

    filedate = Format(Now, "mm.dd.yyyy")
    folderyear = Format(Now, "yyyy")
    filepath = "Path"
    filename = filedate & " " & "Draft.xlsx"
    Set wbkOpen = Workbooks.Open(filepath & filename, False, True)
    wbkOpen.Worksheets("infosheet").Columns("M:O").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    For i = 1 To wbkOpen.Worksheets("infosheet").Cells(Rows.Count, 1).End(xlUp).Row

        For j = 1 To ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
            If wbkOpen.Worksheets("infosheet").Range("C" & i) = ThisWorkbook.Worksheets("Sheet1").Range("B" & j) Then
                ThisWorkbook.Worksheets("Sheet1").Range("G" & j & ":I" & j) = wbkOpen.Worksheets("infosheet").Range("M" & i & ":O" & i)
            End If

        Next j
    Next i


End Sub

Answer 1

想出来！需要将.Value添加到IF语句中。

Sub update()

Dim filename As String
Dim filedate As String
Dim filepath As String
Dim folderyear As String
Dim i As Double
Dim j As Double
Dim LastRow As Range
Dim TargetLastRow

filedate = Format(Now, "mm.dd.yyyy")
folderyear = Format(Now, "yyyy")
filepath = "Path"
filename = filedate & " " & "Draft.xlsx"
Set wbkOpen = Workbooks.Open(filepath & filename, False, True)
wbkOpen.Worksheets("infosheet").Columns("M:O").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

For i = 1 To wbkOpen.Worksheets("infosheet").Cells(Rows.Count, 1).End(xlUp).Row

    For j = 1 To ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
        If wbkOpen.Worksheets("infosheet").Range("C" & i).Value = ThisWorkbook.Worksheets("Sheet1").Range("B" & j).Value Then
            ThisWorkbook.Worksheets("Sheet1").Range("G" & j & ":I" & j).Value = wbkOpen.Worksheets("infosheet").Range("M" & i & ":O" & i).Value
        End If

    Next j
Next i

End Sub

比较两个电子表格中的数据，并根据匹配将信息从一个复制到另一个

1 个答案: