데이터 상태 확인 및 시트 간 복사

Question

VBA를 처음 사용했습니다. 누군가 나를 도울 수 있기를 바랍니다. 고마워.

시트 (1)

 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) (출력 시트)

(데이터는 시트 (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 

을 시도하십시오를 게시하면 결과