Открытие книги с использованием значений массива

#arrays #excel #vba #string

#массивы #excel #vba #строка

Вопрос:

Я пытаюсь открыть книги, используя сохраненные значения массива.

Единственная ошибка Workbooks.Open(StoreList(0)) , с которой я сталкиваюсь, — это то, где я сталкиваюсь

«ошибка времени выполнения 0 нижний индекс вне диапазона»

но адрес указан правильно.

 Sub uniquestores()
    '
    ' uniquestores Macro
    '
    Dim lastrow As Long
    Dim x, y, z, uniquestores As Integer
    Dim StoreList(), paths() As String
    Dim csv, strPath As String
    Dim wbs As Workbook
     
    strPath = "C:Usersj.tungDownloadsExcel VBA and MacrosSWIMLANE TAGGING"
    csv = ".csv"
    'to count how many rows have data using column F

    Sheets("Sheet1").Select
    ActiveSheet.Range("F1").Select
    Range(Selection, Selection.End(xlDown)).Select
    lastrow = Selection.Cells.Count
    
    'add new sheet and get the list of unique stores and count how many there are
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "uniquestorecount"
    Range("A1").Formula2 = "=UNIQUE(Sheet1!F2:F" amp; lastrow amp; ")"
    uniquestores = Cells(Rows.Count, "A").End(xlUp).Row
        
    'to check
    Range("D1").Value = uniquestores
    Range("E1").Value = lastrow
    Range("F1").Value = strPath
        
    'to get only the store name. without the "pandamart ()"
    For y = 0 To uniquestores - 1
        Range("B" amp; y   1).FormulaR1C1 = "=MID(RC[-1],12,LEN(RC[-1])-12)"
    Next y
    
    'to store the store names in an array. also adds ".csv" to be able to get workbook name
    For x = 0 To uniquestores - 1
        ReDim StoreList(x To uniquestores)
        StoreList(x) = strPath amp; Range("B" amp; x   1) amp; csv
        Range("C" amp; x   1).Value = StoreList(x)
    Next x
    
    'delete the sheet to get the store names.  a pop-up will appear to ask if you really want to delete it.
    'application.display will be triggered not to pop-up and it will automatically say "okay" to delete
    Application.DisplayAlerts = False
    Sheets("uniquestorecount").Delete
    Application.DisplayAlerts = True
    
    'For z = 0 To uniquestores - 1
    'paths(x) = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Chapter "   CStr(x))
    'Application.DisplayAlerts = False
    'paths(0) = Application.GetOpenFilename(FileFilter:="Microsoft Excel Comma Separated Values File (*.CSV), *.CSV")
    Workbooks.Open(StoreList(0))
    'Application.DisplayAlerts = True
    'Next z
    
End Sub
 

Комментарии:

1. Переместитесь ReDim за пределы цикла и измените его на ReDim StoreList(0 To uniquestores - 1)

2. Или используйте коллекцию вместо массива — вы можете просто Add элементы без необходимости изменять размер чего-либо.

Ответ №1:

Используйте объект словаря и избегайте создания временного листа.

 Option Explict
Sub UniqueStores2()
    ' uniquestores Macro
    Const FOLDER = "C:Usersj.tungDownloadsExcel VBA and MacrosSWIMLANE TAGGING"
    Const EXT = ".csv"
    Const PREFIX = "pandamart ()"
    
    'to count how many rows have data using column F
    Dim ar, lastrow As Long
    With Sheets("Sheet1")
        lastrow = .Cells(.Rows.Count, "F").End(xlUp).Row
        ar = .Range("F2:F" amp; lastrow).Value2
    End With
    
    ' get unique stores
    Dim dict As Object, key As String, i As Long
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(ar)
        key = Trim(ar(i, 1))
        If key Like PREFIX amp; "*" Then
            If Not dict.exists(key) Then  
               dict.Add key, FOLDER amp; Mid(key, Len(PREFIX)   1) amp; EXT
           End If
        End If
    Next
    
    ' into array
    Dim StoreList
    StoreList = dict.items
    For i = 0 To UBound(StoreList)
        Debug.Print StoreList(i)
    Next
End Sub