我有一个名为SheetNames
的工作表名称的数组,我想生成一个只在条件(IF)返回True的子数组。我尝试将一个单元格值循环到不同的工作表上,评估条件cell.value = "S"
。当检查第一个D列(z = 4)时,我想对同一行的列D到DR进行相同的检查(IF条件)。
如果我在
使用公式,我需要得到类似的结果Diary!C7
= IF (element!D6 = "S",CONCATENATE (element!B1, ", "), ""),
IF (element1!D6 = "S",CONCATENATE (element1!B1, ", "), ""), ....
IF (element!E6 = "S",CONCATENATE (element!B1, ", "), ""),
IF (element1!E6 = "S",CONCATENATE (element1!B1, ", "), "") .... )
其中element是从数组中取得的工作表名称,工作表名称获取条件(代码S或其他代码)。
SheetNames是一个包含所有工作表和FSheet(带有条件的Filtered Sheet)的数组,只有过滤的数组(条件为IF)。当我可以为每个工作表填充FSheet数组时,我测试条件然后我必须在另一个工作表/单元格中连接它的值并再次开始测试条件到下一个单元格(E6)......但是我是困在创建FSheet的步骤。
Sub Test()
Dim ws As Worksheet
Dim SheetNames() As String, FSheets() As String, q As String
Dim element As Variant
Dim lastSheet As Integer, r As Integer, incrSheet As Integer, i As Integer
Dim Rgn As Range
' Enter the sheet names into an array. Redim array's size to the number of sheets (lastSheet)
For Each ws In ActiveWorkbook.Worksheets
ReDim Preserve SheetNames(lastSheet)
SheetNames(lastSheet) = ws.name
lastSheet = lastSheet + 1
Next ws
MsgBox lastSheet
' Test condition for each sheet/cell
For z = 4 To 11
For Each element In SheetNames()
incrSheet = 1
If ActiveWorkbook.Sheets(element).Cells(6, z).Value = "S" Then
ReDim Preserve FSheets(incrSheet)
FSheets(incrSheet) = element
incrSheet = incrSheet + 1
End If
Next element
Next z
i = 3
' Define the sheet to work (total project will have more than one, one for code we need test, S, C, etc)
With Worksheets("Diary")
.Activate
.Range("C7").Select
' Concatenate values at Summary page
Do
Cells(7, i).Select
For r = 1 To UBound(FSheets)
'Concatenate with &:
varConctnt = varConctnt & ", " & FSheets(r)
Next r
'remove the "&" before the first element:
varConctnt = Mid(varConctnt, 2)
q = varConctnt
varConctnt = ""
i = i + 1
ActiveCell.Value = q
Loop While i < 11
' Drag the formula for the rest of the rows
Range("C7:J7").Select
Selection.AutoFill Destination:=Range("C7:J12"), Type:=xlFillDefault
End With
End Sub
答案 0 :(得分:1)
如果出错,您是否尝试动态设置范围。假设您正在测试单个单元格的值,则使用单元格而不是Range会更容易,因为您可以使用R1C1表示法。尝试这样的事情:
incrSheet = 1
For z = 4 To 11
For Each element In SheetNames()
If ActiveWorkbook.Sheets(element).Cells(6, z).Value = "S" Then
ReDim Preserve FSheets(incrSheet)
FSheets(incrSheet) = element
MsgBox incrSheet
incrSheet = incrSheet + 1
End If
Next element
Next z