Поиск состояния данных и копирование между листами

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 (Data)

 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 

Задача: Мне нужно проверить состояние следующих идентификаторов 455, 476 и 497 на листе 3. Если состояние всех идентификаторов в строке закрыто, то скопируйте всю строку из листа 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 

Ниже приведены результаты