无法将字符串传递给数组函数:下标超出范围

时间:2016-10-12 12:54:36

标签: arrays vba excel-vba excel

我正在尝试模仿将多个工作表复制到新工作簿中,如果我真的在数组函数中使用工作表名称,这很好。

但是,如果我尝试将字符串变量传递给数组,我会得到一个超出范围错误的下标。

关注的是:

Wb.Sheets(Array(SheetsArray)).Copy After:=RegionWb.Sheets(RegionWb.Sheets.count)

请参阅下面的代码:

Sub CreateFiles()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim WKC As String: WKC = Replace(DateValue(DateAdd("ww", -1, Now() - (Weekday(Now(), vbMonday) - 1))), "/", ".")
    Dim FilePath As String: FilePath = "Z:\MI\Krishn\Retail"
    Dim BuyerLastRow As Long
    Dim Wb As Workbook: Set Wb = ActiveWorkbook
    Dim RegionWb As Workbook
    Dim RegionCount As Integer
    Dim RegionCounter As Integer
    Dim SheetsArray As String
        With BuyerList
            LastRow = .Range("G1048576").End(xlUp).Row
            BuyerLastRow = .Range("A1048576").End(xlUp).Row
            'Create WKC Dir

            If Dir(FilePath & "\" & WKC, vbDirectory) = "" Then
                MkDir FilePath & "\" & WKC
            End If

            'Create Create Files
            If CountFiles(FilePath & "\" & WKC) = 0 Then
                For i = 2 To LastRow
                    RegionCounter = 0
                    SheetsArray = ""
'                    Set RegionWb = Workbooks.Add
'                    'wb.SaveAs FilePath & "\" & WKC & "\" & .Cells(i, 7).Value
'                    RegionWb.SaveAs FilePath & "\" & WKC & "\" & "WKC " & WKC & " - " & .Cells(i, 7).Value & ".xlsb", 50

                        For j = 2 To BuyerLastRow
                            RegionCount = Application.WorksheetFunction.CountIf(.Range("C:C"), .Cells(i, 7).Value)
                            If .Cells(i, 7).Value = .Cells(j, 3).Value Then
                                SheetsArray = SheetsArray & """" & .Cells(j, 2).Value & ""","
                                RegionCounter = RegionCounter + 1
                                If RegionCounter = RegionCount Then
                                    Debug.Print Left(SheetsArray, Len(SheetsArray) - 1)
                                    Set RegionWb = Workbooks.Add
                                    RegionWb.SaveAs FilePath & "\" & WKC & "\" & "WKC " & WKC & " - " & .Cells(i, 7).Value & ".xlsb", 50
                                    'Wb.Sheets(Array(Left(SheetsArray, Len(SheetsArray) - 1))).Copy After:=RegionWb.Sheets(RegionWb.Sheets.count)
                                    SheetsArray = Left(SheetsArray, Len(SheetsArray) - 1)
                                    Wb.Sheets(Array(SheetsArray)).Copy After:=RegionWb.Sheets(RegionWb.Sheets.count)
                                    'Wb.Sheets(Array()).Copy After:=RegionWb.Sheets(RegionWb.Sheets.count)
                                    RegionWb.Save
                                    RegionWb.Close
                                    Exit For
                                End If
'                                Wb.Sheets(Wb.Sheets("Buyer list").Range(Cells(j, 2).Address).Value).Copy After:=RegionWb.Sheets(RegionWb.Sheets.count)
                            End If
                        Next j
'
'

                Next i
            End If


        End With
    Application.ScreenUpdating = True
End Sub

1 个答案:

答案 0 :(得分:1)

您可以将字符串拆分为数组,如下所示:

Wb.Sheets(Split(SheetsArray, ",")).Copy After:=RegionWb.Sheets(RegionWb.Sheets.Count)

正如GSerg指出的那样:您需要删除工作表名称周围的引号。

SheetsArray = SheetsArray & .Cells(j, 2).Value & ","

反斜杠是一个使用逗号的更安全的分隔符,因为Worksheet名称可以包含逗号但不包含反斜杠。

SheetsArray = SheetsArray & .Cells(j, 2).Value & "/"

Wb.Sheets(Split(SheetsArray, "/")).Copy After:=RegionWb.Sheets(RegionWb.Sheets.Count)