Question

我是新来的。我一直试图解决这个问题，但无济于事。我的目标是：

1）需要在Installment工作簿中找到匹配的单元格，并将数据粘贴到与匹配单元格相同的行中的下一个空单元格中。匹配的单元格将来自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

如果我理解正确，这应该有效。我对你的代码进行了一些“调整”，主要删除了“select”语句，这些语句通常是不受欢迎的，也是不必要的。

    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

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

1 个答案: