У меня есть основной код и 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