Suchwort weiterzählen
22.10.2018 09:33:54
Anna
folgendes Programm habe ich mit Hilfe des Internets zusammen gebastelt.
Eine Datei soll durch Anklicken einer Schaltfläche eingelesen werden.
Diese Datei soll dann in Excel durchsucht und verarbeitet werden.
Das Suchwort wäre als Beispiel Test (1), Test (2), Test (3), Test (4) also ein Wort + 1.
Der Bereich zwischen 2 Suchwörtern soll dann kopiert und in ein anderes Blatt um geschaufelt werden. Diese Schritte wären dann alle 620 Zellen. Das ganze möchte ich mit Variablen ausdrücken. Ohne habe ich es hinbekommen, das ist aber sehr viel Schreibarbeit bei einer Änderung der Schritte. Vielleicht kann mir jemand helfen.
Liebe Grüße
Public Sub importMessdaten()
Dim Arr2
'Dim A
Dim Datei2
Dim FSO2
Dim L2 As Long
Dim Tmp2 As Variant
Dim vnt_Ausgabe2 As Variant
Dim I2 As Integer
Dim Str_String2 As String
Dim dateiname2 As String
Dim z2 As Integer
Dim i As Integer
Dim z As Integer
'Zweite datei einfügen
Application.ScreenUpdating = False
dateiname2 = Application.GetOpenFilename
Set FSO2 = CreateObject("Scripting.FilesystemObject")
Set Datei2 = FSO2.OpentextFile(dateiname2) 'Anpassen
Str_String2 = Datei2.readall
Datei2.Close
Arr2 = Split(Str_String2, vbCrLf) 'Nach Datensätzen splitten
ReDim vnt_Ausgabe2(UBound(Arr2), 200) '200 Spalten reichen ?
For L2 = 0 To UBound(Arr2)
Tmp2 = Split(Arr2(L2), ",") 'Jeden Datensatz nach Werten splitten
For I2 = 0 To UBound(Tmp2)
vnt_Ausgabe2(L2, I2) = Tmp2(I2) 'Jeden Wert in das Array vnt_Ausgabe umschaufeln
Next
Next
'Ausgeben. Anpassen.
Sheets.Add
ActiveSheet.Name = "Import Messdaten"
Sheets("Import Messdaten").Range("A1").Resize(UBound(vnt_Ausgabe2) + 1, UBound(vnt_Ausgabe2, 2)) _
= vnt_Ausgabe2
For i = 1 To 24
For z = 10 To 18000 Step 620
ThisWorkbook.Worksheets.Add.Name = "Auswertung"
Sheets("Import Messdaten").Select
With Range(Cells.Find(what:="$ELE (NAM = Test(i)", Lookat:=xlWhole).Offset(0, 0), Cells.Find( _
what:="Test(i+2)", Lookat:=xlWhole).Offset(-3, 0)).Resize(, 12).Select
End With
Selection.Copy
'Debug.Print ActiveSheet.Name
'Sheets.Add
'ActiveSheet.Name = "Rohdaten"
Application.Goto ActiveWorkbook.Sheets("Auswertung").Range(Cells(1, z))
ActiveSheet.Paste
Sheets("Import Messdaten").Select
Next z
Next i
Application.DisplayAlerts = False
Sheets("Import Messdaten").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = False
End Sub