26枚のワークブックがあります。セル「D15」から始まる特定の17枚のシートのみでD列をスキャンしたい。ただし、これらの 15 枚のシートはインクリメンタルな順序になっています。つまり、4 枚目と 20 枚目の間をスキャンしたいと考えています。
次のコードは私がこれまでに持っているものです。ユーザー「ケータリングの責任者」は、以前の質問でそれを使い始めました:コピー ペースト マクロは「グループ化された」ワークシート機能を誘導していますか?
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
サブ終了