创建子数组变量名称表

Question

我有一个名为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（带有条件的过滤表）是一个仅包含过滤后的数组（带有条件 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

Answer 1

您出错的地方是您尝试动态设置范围。假设您正在测试单个单元格的值，使用单元格比使用范围要容易得多，因为您可以使用 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