创建子数组变量名称表

时间:2017-09-14 03:50:23

标签: excel vba excel-vba

我有一个名为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

1 个答案:

答案 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