0

私はここでは新人です。私はこの問題を解決しようとしましたが、役に立ちませんでした。私の目標は次のとおりです。

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
4

1 に答える 1

0

私があなたを正しく理解しているなら、これはうまくいくはずです。私はあなたのコードにいくつかの「微調整」を加えました。主に、通常は望ましくなく不要な「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
于 2013-10-23T05:09:40.360 に答える