Excel VBA : 일정한 범위의 워크 시트를 검색하는 루프

Question

통합 문서에 26 개의 시트가 있습니다. 셀 "D15"에서 시작하여 해당 시트 중 특정 17 개에서만 D 열을 스캔하려고합니다. 이 15 장은 증분 순서대로 진행되지만 4 장과 20 장 사이를 스캔하려고합니다. 지금까지 사용자 "외식의 헤드는"이전의 질문에 날을 시작했다 것을

다음 코드는 다음과 같습니다

: 여기에 다음 Copy Paste macro is inducing 'grouped'-worksheet functionality?

Sub DSR_Autofill() 

Variable Declarations: 

Dim x_count As Long  'keeps track of how many "x"s you have 
Dim i As Long   'for loop index 
Dim n As Long   'while loop index 

' Variable Initializations: 

x_count = 0    'start x count at zero 

' Clear Previous Data: 

Sheets(2).Range("A25:A29").ClearContents  'Clears Summary Pages before scanning through 
Sheets(3).Range("A18:A200").ClearContents 

' Main Data Transfer Code: 

For i = 5 To i = 20  'Starts at "Process Controls" and ends on "Product Stewardship" 

    Sheets(i).Select 'Select current indexed worksheet and... 
    Range("D15").Select '...the first item cell in the "Yes" Column 

    n = 0    'initialize n to start at top item row every time 

     Do While ActiveCell.Offset(n, -3) <> Empty  'Scan down "YES" column until Item Column (just A Column)... 
                 '...has no characters in it (this includes space (" ")) 
      Call Module2.algorithm(x_count, n) 'See subroutine code 
      Sheets(i).Select     'Return to frame of reference 
      Range("D15").Select 

     Loop   'syntax for continuation of while loop 

    i = i + 1 

Next i     'syntax for continuation of for loop 


If (x_count > 5) Then    'Bring user back to the Summary Page where... 
            '...the last Item was logged 
    Sheets("SUMMARY P.2").Select 

Else 

    Sheets("SUMMARY P.1").Select 

End If 

End Sub 

그리고 알고리즘 코드

Sub algorithm(x_count As Long, n As Long) 

Dim item_a As String 'Letter part of Item 
Dim item_b As String 'Number part of Item 

     'If an "x" or "X" is marked in the "Yes" column, 
     'at descending cells down the column offset by the for loop index, n 

     If (ActiveCell.Offset(n, 0) = "x" Or ActiveCell.Offset(n, 0) = "X") Then 

      item_a = ActiveCell.Offset(n, -3).Value  ' Store Letter value 
      item_a = Replace(item_a, "(", "")   ' Get rid of "(", ")", and " " (space) 
      item_a = Replace(item_a, ")", "")   ' characters that are grabbed 
      item_a = Replace(item_a, " ", "") 

      item_b = ActiveCell.Offset(n, -2).Value  ' Store number value 
      item_b = Replace(item_b, "(", "")   ' Get rid of "(", ")", and " " (space) 
      item_b = Replace(item_b, ")", "")   ' characters that are grabbed 
      item_b = Replace(item_b, " ", "") 

      x_count = x_count + 1      ' increment the total x count 

      If (x_count > 5) Then      ' If there are more than 5 "x" marks, 

       Sheets("SUMMARY P.2").Activate   ' then continue to log in SUMMARY P.2 
       Range("A18").Select      ' Choose "Item" column, first cell 
       ActiveCell.Offset((x_count - 6), 0).Value = (item_a & item_b) 

       'Insert cocatenated value of item_a and item_b 
       '(for example "A" & "1" = "A1") 
       'at the cells under the "Item" column, indexed by x_count 

      Else          ' If there are less than 5 "x" marks, 

       Sheets("SUMMARY P.1").Activate   ' log in SUMMARY P.1 
       Range("A25").Select      ' Choose "Item" column, first cell 
       ActiveCell.Offset((x_count - 1), 0).Value = (item_a & item_b) 

      End If 

     End If 

    n = n + 1 

최종 하위

Answer 1

[편집] : 새로운 정보를 기반으로 업데이트 된 코드 :

Sub DSR_Autofill() 

    Dim wsSummary1 As Worksheet 
    Dim wsSummary2 As Worksheet 
    Dim rngFound As Range 
    Dim arrSummary1(1 To 5) As String 
    Dim arrSummary2(1 To 65000) As String 
    Dim strFirst As String 
    Dim strTemp As String 
    Dim DataIndex1 As Long 
    Dim DataIndex2 As Long 
    Dim xCount As Long 
    Dim i As Long 

    Set wsSummary1 = Sheets("SUMMARY P.1") 
    Set wsSummary2 = Sheets("SUMMARY P.2") 

    wsSummary1.Range("A25:A29").ClearContents 
    wsSummary1.Range("A18:A" & Rows.Count).ClearContents 

    For i = Sheets("Process Controls").Index To Sheets("Product Stewardship").Index 
     With Sheets(i).Range("D15", Sheets(i).Cells(Rows.Count, "D").End(xlUp)) 
      Set rngFound = .Find("x", .Cells(.Cells.Count), xlValues, xlWhole) 
      If Not rngFound Is Nothing Then 
       strFirst = rngFound.Address 
       Do 
        strTemp = Replace(Replace(Replace(Sheets(i).Cells(rngFound.Row, "A").Text & Sheets(i).Cells(rngFound.Row, "B").Text, "(", ""), ")", ""), " ", "") 
        If xCount < 5 Then 
         DataIndex1 = DataIndex1 + 1 
         arrSummary1(DataIndex1) = strTemp 
        Else 
         DataIndex2 = DataIndex2 + 1 
         arrSummary2(DataIndex2) = strTemp 
        End If 
        xCount = xCount + 1 
        Set rngFound = .Find("x", rngFound, xlValues, xlWhole) 
       Loop While rngFound.Address <> strFirst 
      End If 
     End With 
    Next i 

    If DataIndex1 > 0 Then wsSummary1.Range("A25").Resize(DataIndex1).Value = Application.Transpose(arrSummary1) 
    If DataIndex2 > 0 Then wsSummary2.Range("A18").Resize(DataIndex2).Value = Application.Transpose(arrSummary2) 

    If xCount > 5 Then wsSummary2.Select Else wsSummary1.Select 

End Sub