vba - 查找匹配数据并粘贴到同一行的下一个空单元格

Question

我刚来这地方。我一直在尝试解决这个问题，但无济于事。我的目标是：

1）需要在分期付款工作簿中找到匹配的单元格并将数据粘贴到与匹配单元格相同行的下一个空单元格中。匹配的单元格将来自 E 列。

Private Sub CommandButton1_Click()
Dim itemNumber As String
Dim itemAmount As Single
Dim myData As Workbook

Worksheets("sheet1").Select
itemNumber = Range("B6")
Worksheets("sheet1").Select
itemAmount = Range("H16")

Set myData = Workbooks.Open("C:\Mydata\Installment.xlsx")
Worksheets("sheet1").Select
Worksheets("sheet1").Range("E1").Select

For Each cell In Range(“E2:E10000”)
IF cell.Value = itemNumber Then
Cellvalue = ActiveCell.address
Next
End IF
ColumnCount = Worksheets("sheet1").Range("Cellvalue").CurrentRegion.Columns.Count
With Worksheets("sheet1").Range("Cellvalue")
.Offset(0, ColumnCount) = itemNumber
.End With
myData.Save
Workbooks("Installment.xlsx").Close
End Sub

Answer 1

如果我对您的理解正确，这应该可以。我对您的代码进行了一些“调整”，主要是删除了“选择”语句，这些语句通常是不受欢迎和不必要的。

    Private Sub CommandButton1_Click()
    Dim itemNumber As String
    Dim itemAmount As Single
    Dim myData As Workbook
    Dim Wk As Worksheet
    Dim Cel As Range

    With ThisWorkbook.Worksheets("sheet1")
        itemNumber = .Range("B6").Value
        itemAmount = .Range("H16").Value
    End With

    Set myData = Workbooks.Open("C:\Mydata\Installment.xlsx")

    Set Wk = myData.Worksheets("sheet1")
    For Each Cel In Wk.Range("E2:E10000")
        If Cel.Value = itemNumber Then
            Cel.Value = Cel.Address
    '       get next blank cell in row
            Wk.Cells(Cel.Row, Wk.Columns.Count).End(xlToLeft).Offset(, 1).Value = itemNumber
        End If
    Next

    myData.Close True 'save & close

    End Sub