查找数据状态并跨工作表复制

Question

我对 VBA 很陌生。希望有人可以帮助我。非常感谢。

表 1（要复制到表 4 的数据）

     A       B        C           D
 1  ID    Header 2  Header 3    Orders
 2 5000                      455,476,497
 3 5012                          500
 4 5015                        502,503 

表 2（数据）

     A         B         C         D ........ Q
1  Orders ID         Header 2   Status   Header 4
2   455                         Closed
3   456                          Open
4   476                         Closed
5   497                         Closed

表 3

   A    B    C    D
1 455  476  497
2 500
3 502  503

表 4（输出表）

     A       B        C           D
 1  ID    Header 2  Header 3    Orders
 2 5000                      455,476,497
 3

任务：我需要检查工作表 3 中以下 ID 455、476 和 497 的状态。如果一行中所有 ID 的状态都已关闭，则将工作表 1 中的整行复制到工作表 4，如果不移动到下一行。

For a = 1 To Range("A1").End(xlDown).Row

    For b = 1 To Range("A1").End(xlToRight).Column
        Cells(1, b).Select

        Selection.Copy
        Sheets("Orders").Select            

       (Unsure what to put here)

    Next b
Next a

我需要更多声望才能在此处发布图片。所以，发布链接 （只允许 2 个）

http://imgur.com/K8H2JhD、http://imgur.com/KjeIDVm、U0Z7mfm、qWOJ3VM

Answer 1

请尝试以下代码

Sub FindStausAndCopy()

Dim sheet1Range As Range
Dim sheet2Range As Range
Dim sheet3Range As Range

Dim sheet1RowCount As Integer
Dim sheet1ColCount As Integer

Dim sheet2RowCount As Integer
Dim sheet2ColCount As Integer

Dim sheet3RowCount As Integer
Dim sheet3ColCount As Integer

Dim shtRowNum As Integer
Dim totalCellsinRow  As Integer
Dim statusCount As Integer
Dim orders As String

Dim range1Row As Variant
Dim range2Row As Variant
Dim range3Row As Variant
Dim cellVal As Variant



sheet1RowCount = Worksheets("Sheet1").UsedRange.Rows.Count
sheet1ColCount = Worksheets("Sheet1").UsedRange.Columns.Count

sheet2RowCount = Worksheets("Sheet2").UsedRange.Rows.Count
sheet2ColCount = Worksheets("Sheet2").UsedRange.Columns.Count

sheet3RowCount = Worksheets("Sheet3").UsedRange.Rows.Count
sheet3ColCount = Worksheets("Sheet3").UsedRange.Columns.Count

Worksheets("sheet1").Activate
Set sheet1Range = Worksheets("Sheet1").Range(Cells(1, 1), Cells(sheet1RowCount, sheet1ColCount))
Worksheets("sheet2").Activate
Set sheet2Range = Worksheets("Sheet2").Range(Cells(1, 1), Cells(sheet2RowCount, sheet2ColCount))
Worksheets("sheet3").Activate
Set sheet3Range = Worksheets("Sheet3").Range(Cells(1, 1), Cells(sheet3RowCount, sheet3ColCount))

shtRowNum = 1 'This is for incrementing the Row in Sheet4
'Iterating through Each row in Sheet3 and then through
'each cell in a particular row
'Loop1
For Each range3Row In sheet3Range.Rows
totalCellsinRow = 0  ' to count no of order numbers in sheet3 rows
statusCount = 0      ' to count the status of orders 
orders = ""          ' to store all order numbers with coma seperated

    'Iterating throgh each Order in a row and identifing the status
    'Loop2
    For Each cellVal In range3Row.Cells
    If (cellVal <> "") Then
     totalCellsinRow = totalCellsinRow + 1 'Increments for every order
     'Iterating through each row in sheet2 to check the status and
     ' Increment status count
     'Loop3
         For Each range2Row In sheet2Range.Rows
            If (range2Row.Cells(1) = cellVal And range2Row.Cells(4) = "Closed") Then
            statusCount = statusCount + 1 'Increments only when order is closed
            orders = orders & ", " & cellVal
            End If
        Next range2Row
        'By the time Loop3 is completed we get the status of one order
        End If
    Next cellVal
    'By the time Loop2 is completed, we get the overall status of all orders
    ' in a row of sheet3
    ' If statusCount = totalCellsinRow which implies every order
    ' present in a row is closed
    If (totalCellsinRow = statusCount) Then
        'Lopp4: Iterating throgh each row of sheet1 to find Matching ID
        'The reason for iterating through rows,even if the order of the ID
        ' changes, code should be in a position to identify the right row
        ' to copy
        For Each range1Row In sheet1Range.Rows
            If (range1Row.Cells(4) = Trim(Right(orders, Len(orders) - 1))) Then
              If (shtRowNum = 1) Then
              'Copying the Header row to sheet4 only once.
              sheet1Range.Rows(1).Copy Destination:=Worksheets("sheet4").Cells(1, 1) 
              shtRowNum = shtRowNum + 1
            End If
            'Copying the row from sheet1 to sheet4
            range1Row.Copy Destination:=Worksheets("Sheet4").Cells(shtRowNum, 1)
            shtRowNum = shtRowNum + 1
          End If
        Next range1Row
        'By the time Loop4 is completed a ID row for the closed Orders will 
        ' be copied to Sheet4
    End If
Next range3Row
'By the time Loop1 is completed all the orders status will be read
' Corresponding Id rows will be copied to sheet4 with Header row

End Sub

以下是结果