Как читать столбцы, которые были сохранены в массиве в VBA - PullRequest
0 голосов
/ 18 июня 2020

У меня есть основной код и 3 функции. Первая функция считывает путь, вторая функция считывает нужные нам параметры, а третья функция считывает ЧИСЛА строк и столбцов, а не адрес из этих параметров. Теперь я хочу, чтобы эта третья функция выводила параметры до конца столбца. Буду рад, если кто-нибудь укажет мне правильное направление. Спасибо! Вот код:

Public Sub DateiSuchen()

    ' im Allgemein-Teil der Form / des Moduls

    Dim oFSO As New FileSystemObject
    ' nur .CSV-Dateien in einer ListBox anzeigen
    Dim oFolder As Folder
    Dim oFile As File
    Dim sh As Worksheet
    Dim i As Integer

    Dim parametri(), adrese() As Variant
    On Error GoTo oError

    parametri = parametars
    'Cursor als default
    Application.Cursor = xlDefault
    'Bildschirmaktualisierung ausschalten
    Application.ScreenUpdating = False
    ' Ausgangsverzeichnis
    Set oFolder = oFSO.GetFolder(pfad)


    ' alle Dateien durchlaufen
    For Each oFile In oFolder.Files
      ' nur .csv Dateien!
      If LCase$(oFSO.GetExtensionName(oFile)) = "csv" Then
        'List1.AddItem oFile.Name
        Debug.Print "Dateiname: " & oFile.Name
        'öffnen .csv Datei
            Workbooks.Open Filename:=oFile, local:=True
            'suchen Parametar A,B und C in Schleife
            For Each sh In ActiveWorkbook.Worksheets
                adrese = parSuchen(parametri, sh)

            Next sh
           ActiveWindow.Close
        End If  'If LCase$(oFSO.GetExtensionName(oFile)) = "csv"
    Next
Exit_DateiSuchen:

    Application.Cursor = xlDefault  'Cursor wiederherstellen
    Application.ScreenUpdating = True  'Bildschirmaktualisierung einschalten
    Exit Sub

oError:

    MsgBox Err.Description, vbOKOnly, "Error " & Err.Number
    Resume Next

End Sub


Private Function pfad() As String

    Dim a As Range

    Set a = Worksheets("Menü").Cells.Find("Import Ordner")
    pfad = Cells(a.Row, a.Column + 1).Value
    'Debug.Print (pfad)

End Function


Private Function parametars() As Variant

    Dim cellFound As Range
    Dim arr() As Variant
    Dim i, n As Long
    ReDim Preserve arr(0) 
    Set cellFound = ThisWorkbook.Worksheets("Menü").Cells.Find("Suchbegriffe")
    i = cellFound.Row
    n = 1
    Do Until IsEmpty(ThisWorkbook.Worksheets("Menü").Cells(i, cellFound.Column + 1))
        'Debug.Print Cells(i, cellFound.Column + 1).Value
        ReDim Preserve arr(n)
        arr(n) = ThisWorkbook.Worksheets("Menü").Cells(i, cellFound.Column + 1)
        Debug.Print arr(n)
        i = i + 1
        n = n + 1
    Loop
    parametars = arr
End Function

Private Function parSuchen(arrPar() As Variant, sh As Worksheet) As Variant

    Dim cellFound As Range
    Dim arr() As Variant
    ReDim Preserve arr(0)
    Dim aLast As Long
    Dim i, j, n As Integer
'    Debug.Print arrPar(1)
'    Debug.Print Cells(4, 1).Value
    Set cellFound = sh.Cells.Find(arrPar(1))
    'Debug.Print cellFound.Row
    j = cellFound.Row
    Debug.Print "Zeile: " & j

    For i = 1 To UBound(arrPar)
        Set cellFound = sh.Rows(j).Find(arrPar(i))
        ReDim Preserve arr(i)
        arr(i) = cellFound.Column
        Debug.Print "Spalte: " & arr(i)
    Next i
    parSuchen = arr

End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...