Question

拥有2个工作表（更新，更改），每个工作表都以变量顺序在每列中包含参数

更新工作表包含以下列：

名称/价值/单位

更改工作表包含以下列：

状态/名称/价值/单位

首先，我使用状态搜索更改行：更改
然后我需要获取该行的名称
要在更新中找到它并复制整行
并将其复制到 Status 列中找到名称后的位置

每个名字都是唯一的，但正如我之前提到的那样，我有一个可变的位置，我的代码到目前为止：

Sub CopyRealChange()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim lr As Long, r As Long, x As Long
Dim chng As Range
Set sh1 = ThisWorkbook.Worksheets("UPDATED")
Set sh2 = ThisWorkbook.Worksheets("CHANGES")

lr = sh2.Cells(Rows.Count, "A").End(xlUp).Row
x = 2
For r = 2 To lr
    If Range("A" & r).Value = "CHANGE" Then 'Evaluate the condition.
        'Sh2.Range("B" & x).Value = Sh1.Range("B" & r).Value 'Copy same Column location
        'FIND
        With Worksheets(2).Range("a1:a1000")
            Set chng = .Find(sh2.Range("B" & x).Value, LookIn:=xlValues)
            If chng Is Nothing Then
                sh1.Range(c).EntireRow.Copy Destination:=sh2.Range("B" & x)
            End If
        End With
        'FIND

    End If
    x = x + 1
Next r

End Sub

所以提前感谢帮助解决我的问题

对代码的关注在此行显示错误（在FIND中）

sh1.Range(c).EntireRow.Copy Destination:=sh2.Range("B" & x)

Answer 1

您的代码存在一些问题。

您没有声明要搜索范围的工作表。

If Range("A" & r).Value = "CHANGE" Then

您在开始时声明了工作表，然后更改了在代码中引用它们的方式。

Set sh2 = ThisWorkbook.Worksheets("CHANGES")

With Worksheets(2).Range("a1:a1000")

以下是我为您所做的：使用简单的循环检查以查看值是否匹配并移动数据。

Sub CopyRealChange()

Dim sh1 As Worksheet, sh2 As Worksheet
Dim tempName As String
Dim lastRow1 As Long
Dim lastRow2 As Long

Set sh1 = ActiveWorkbook.Worksheets("UPDATED")
Set sh2 = ActiveWorkbook.Worksheets("CHANGES")

    lastRow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row    'Get last row for both sheets
    lastRow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row    'because you are searching both

    For s2Row = 2 To lastRow2                              'Loop through "CHANGES"
        If sh2.Cells(s2Row, 1).Value = "CHANGE" Then
            tempName = sh2.Cells(s2Row, 2).Value           'extra step for understanding concept
                                                           'There is a match, so now
            For s1Row = 2 To lastRow1                      'Search through the other sheet
                If sh1.Cells(s1Row, 1).Value = tempName Then                  
                    sh2.Cells(s2Row, 3).Value = sh1.Cells(s1Row, 2).Value    'Copy Values
                    sh2.Cells(s2Row, 4).Value = sh1.Cells(s1Row, 3).Value    
                End If
            Next s1Row
        End If
    Next s2Row
End Sub

Excel VBA：查找参数，将找到的行复制到另一个工作表（从特定单元格开始粘贴）

1 个答案: