用工作表名称连接数组excel vba

Question

请查看代码下方的问题。提前致谢

 Dim Acount As Long
Dim Bcount As Long
Dim Ccount As Long
Dim Dcount As Long
Dim Ecount As Long
Dim Fcount As Long
Dim Gcount As Long
Dim Hcount As Long
Dim Rcount() As Long
Dim Numrows As Long
Dim NamAry(1 To 7) As Variant
Dim SheetsVal(1 To 7) As Variant
Dim Pub(1 To 7) As Variant

    Workbooks.Open Filename:="N:\Desktop\Data.xlsx", ReadOnly:=True
    Sheets("Academy").Select
    ActiveSheet.Range("$A:$U").AutoFilter Field:=1, Criteria1:=Workbooks(Data2.xlsm).Worksheets("4.1").Range("$J$5"), Operator:=xlAnd
    Acount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1


    Sheets("Cambridge").Select
    ActiveWindow.SmallScroll Down:=-3
    ActiveSheet.Range("$A:$T").AutoFilter Field:=1, Criteria1:=Workbooks(Data2.xlsm).Worksheets("4.1").Range("$J$5"), Operator:=xlAnd
    Bcount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1


    Sheets("Brantford").Select
    ActiveSheet.Range("$A:$Q").AutoFilter Field:=1, Criteria1:=Workbooks(Data2.xlsm).Worksheets("4.1").Range("$J$5"), Operator:=xlAnd
    Ccount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1

    Sheets("Sherwood").Select
    ActiveSheet.Range("$A:$Q").AutoFilter Field:=1, Criteria1:=Workbooks(Data2.xlsm).Worksheets("4.1").Range("$J$5"), Operator:=xlAnd
    Dcount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1

    Sheets("KMY").Select
    ActiveSheet.Range("$A:$Y").AutoFilter Field:=1, Criteria1:=Workbooks(Data2.xlsm).Worksheets("4.1").Range("$J$5"), Operator:=xlAnd
    Ecount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1

    Sheets("Ship").Select
    ActiveSheet.Range("$A:$AA").AutoFilter Field:=1, Criteria1:=Workbooks(Data2.xlsm).Worksheets("4.1").Range("$J$5"), Operator:=xlAnd
    Fcount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1

    Sheets("PFS").Select
    ActiveSheet.Range("$A:$T").AutoFilter Field:=1, Criteria1:=Workbooks(Data2.xlsm).Worksheets("4.1").Range("$J$5"), Operator:=xlAnd
    Gcount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1

    Sheets("DUMP").Select
    ActiveSheet.Range("$A:$T").AutoFilter Field:=3, Criteria1:=Workbooks(Data2.xlsm).Worksheets("4.1").Range("$J$5"), Operator:=xlAnd
    Hcount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1


    'Sheets("Sheet9").Select
        'Range("A1").Select
        'NamAry = Array(Acount, Bcount, Ccount, Dcount, Ecount, Fcount)
   ' MsgBox NamAry()

NamAry(1) = Acount
NamAry(2) = Bcount
NamAry(3) = Ccount
NamAry(4) = Dcount
NamAry(5) = Ecount
NamAry(6) = Fcount
NamAry(7) = Gcount

SheetsVal(1) = "Academy"
SheetsVal(2) = "Cambridge"
SheetsVal(3) = "Brantford"
SheetsVal(4) = "Sherwood"
SheetsVal(5) = "KMY"
SheetsVal(6) = "Ship"
SheetsVal(7) = "PFS"


For INX = LBound(NamAry) To UBound(NamAry)
  Debug.Print NamAry(INX)
Next

For INX = 1 To 7
    If NamAry(INX) > 0 Then
        Pub(INX) = SheetsVal(INX)
    End If
Next

For INX = LBound(Pub) To UBound(Pub)
  Debug.Print Pub(INX)
Next

所以我得到以下输出 13

0

0

0

4

12

0

1.学院

2.

3.

4.KMY

5.

6.运送

7.

我怎样才能得到一个数组，让我们说 Pub 在这种情况下没有空格，这是输出格式= pub = Array("学院", "KMY", "船舶") 我需要在一组代码中使用它，但无法弄清楚这一点。基本上，我正在寻找一个连接数组，其工作表名称的行>0 基于自动过滤结果

任何帮助将不胜感激。

Answer 1

这种方法不是更好吗？

Sub CountNonZeroFilters()

Dim cl As Range
Dim output() As Variant
Dim i As Long
Dim sht As Worksheet

ReDim output(0 To 0)

'loop over all worksheets in book
For Each sht In ActiveWorkbook.Worksheets

    Select Case sht.Name

        'list all the sheets you want to check here
        Case "Academy", "Cambridge", "Brantford"

               'loop over cells in filter column
               For Each cl In sht.Range(sht.Range("A2"), sht.Range("A2").Offset(sht.Range("A2").CurrentRegion.Rows.Count, 0))

                    'if cell meets filter criteria add sheet name to array and go to next sheet
                    If cl.Value = Sheets("4.1").Range("J5").Value Then

                        ReDim Preserve output(0 To UBound(output) + 1)
                        output(i) = sht.Name
                        i = i + 1
                        GoTo nextSht

                    End If

                Next cl

        Case Else

            'do nothing

    End Select

nextSht:

Next sht


'test array

For i = 0 To UBound(output)

    Debug.Print output(i)

Next i

End Sub