Question

如果满足某些条件（同一列数据），我正在尝试将数据从一张纸转移到另一张纸。

我想我已经找到了一种方法，但是我无法选择表的行号（它们不是固定的）

   Sheet 1      

Buyer   Item    Quantity    
Jack    Pen     16  
Jack    Table   3   
Jack    Chair   9   
Mark    Pen     10  
Mark    Chair   2   
Alice   Chair   4   


   Sheet 2      

Buyer Pen Table Chair
Jack  16    3     9
Mark  10          2
Alice             4

您看到我希望工作表1中的数量进入工作表2中的右列

已编辑的错误：如果出现以下情况，则第一个错误： 424必需的对象

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim i As Integer
    Dim j As Integer
    Dim r As Integer
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet

    Set sh1 = Me.Worksheets("Sheet 1")
    Set sh2 = Me.Worksheets("Sheet 2")

    For i = 2 To sh2.Range(sh2.Cells("1", "A"), sh2.Range("A1").End(xlDown)).Rows.Count

        For j = 2 To sh1.Range(sh1.Cells("1", "A"), sh1.Range("A1").End(xlDown)).Rows.Count

            If sh1.Cells(j, "A").Value Is sh2.Cells(i, "A").Value Then

                For r = 3 To 16

                    If sh1.Cells(j, 16).Value Is sh2.Cells(1, r).Value Then

                        sh2.Cells(j, r).Value = sh1.Cells(i, 18).Value

                    End If

                 Next

            End If

        Next

    Next

End Sub

在此先感谢您的帮助，如果已经发布，则表示抱歉。

Answer 1

您可以尝试以下代码：假设您有两个名为“ Sheet1”和“ Sheet2”的工作表

Sub match_data()

Dim sh1 As Worksheet
Set sh1 = ThisWorkbook.Sheets("Sheet1")
Dim sh2 As Worksheet
Set sh2 = ThisWorkbook.Sheets("Sheet2")

Dim buyer As String
Dim item As String
Dim quantity As Integer
For a = 2 To sh1.Range("A" & Rows.Count).End(xlUp).Row
    buyer = sh1.Range("A" & a).Value
    item = sh1.Range("B" & a).Value
    quantity = sh1.Range("C" & a).Value

    'Look if buyer already exist in Sheet2
    Dim buyer_exist As Boolean: buyer_exist = False

    If sh2.Range("A" & Rows.Count).End(xlUp).Row > 1 Then
        For b = 2 To sh2.Range("A" & Rows.Count).End(xlUp).Row
            If sh2.Range("A" & b).Value = buyer Then
                buyer_exist = True
                'look for the right column to place the number
                For c = 2 To 4
                    If sh2.Cells(1, c).Value = item Then
                        'assign the quantity
                        sh2.Cells(b, c).Value = quantity
                        Exit For
                    End If
                Next c
            End If
        Next b

        'Add a new row for the buyer
        If buyer_exist = False Then
            For c = 2 To 4
                If sh2.Cells(1, c).Value = item Then
                    'assign the quantity
                    sh2.Cells(sh2.Range("A" & Rows.Count).End(xlUp).Row + 1, 1).Value = buyer
                    sh2.Cells(sh2.Range("A" & Rows.Count).End(xlUp).Row, c).Value = quantity
                    Exit For
                End If
            Next c
        End If

    Else
        'Add a new row for the buyer
        If buyer_exist = False Then
            For c = 2 To 4
                If sh2.Cells(1, c).Value = item Then
                    'assign the quantity
                    sh2.Cells(sh2.Range("A" & Rows.Count).End(xlUp).Row + 1, 1).Value = buyer
                    sh2.Cells(sh2.Range("A" & Rows.Count).End(xlUp).Row, c).Value = quantity
                    Exit For
                End If
            Next c
        End If

    End If

Next a


End Sub

在工作表之间传输数据并修复`424`对象

1 个答案: