24.04.2016, 07:16
Hallo Sunny,
das Eintragen nebeneinander funktioniert so:
Ich habe dazu folgende Änderungen eingebracht:
Hier habe ich die Spaltenberechnung eingefügt:
With Cells(lStart, 3 + Abs(InStr(strLine, strSearch2) = 0))
Die Zeilennummer erhöhe ich nur noch, wenn der Suchstring strSearch1 vorkommt:
If InStr(strLine, strSearch1) > 0 Then lStart = lStart + 1
Ich hab den zwar als 1 definiert, aber im ifc ist das der zweite und damit letzte von den beiden.
Wenn Du nun noch mehr Klassen importieren willst, musst Du die Suchstrings entsprechend erweitern.
Das beginnt mit
Dim strSearch3$
setzt sich fort mit
strSearch3 = "irgendwas"
geht weiter mit
If InStr(strLine, strSearch1) > 0 Or InStr(strLine, strSearch2) > 0 Or InStr(strLine, strSearch3) > 0 Then
muss auch hier rein, allerdings etwas anders
alt
With Cells(lStart, 3 + Abs((InStr(strLine, strSearch2) = 0)))
neu (ungetestet)
With Cells(lStart, 3 + Abs(1 * (InStr(strLine, strSearch1) > 0)) + Abs(2 * (InStr(strLine, strSearch1) > 0)))
und wenn der Suchstring strSearch1 nicht mehr der letzte ist, sondern z.B. der strSearch3, muss es auch hier geändert werden
If InStr(strLine, strSearch3) > 0 Then lStart = lStart + 1
Das Ganze funktioniert aber nur, wenn alle Suchstrings pro Bereich jeweils maximal ein mal kommen und der für den Zeilenwechsel verantwortliche dabei der letzte im Bereich ist.
das Eintragen nebeneinander funktioniert so:
Sub IFC_Einlesen()
'Variablendeklaration
'String
Dim strLine$, strCutter$, arrText, strSearch1$, strSearch2$
'Integer
Dim iCol%
'Long
Dim lStart&
'Dateneintrag ab Zeile 1
lStart = 1
'Suchwort, ggf. per Inputbox
strSearch1 = "IFCQUANTITYAREA"
strSearch2 = "IFCSPACE"
'Datei Oeffnen mit Dialog
Open Datei_Dialog For Input As #1
'Schleife bis Dateiende
Do While Not EOF(1)
'Zeile einlesen
Line Input #1, strLine
'nur importieren wenn strSearch vorhanden
'ggf. Großschreibung verarbeiten
If InStr(strLine, strSearch1) > 0 Or InStr(strLine, strSearch2) > 0 Then
'Klammer und Semikolon am Ende abtrennen
strLine = Left(strLine, Len(strLine) - 2)
'Umlaute ersetzen
strReplace strLine
'Trennzeichen =
strCutter = "="
'Zeilennummer abtrennen
arrText = Split(strLine, strCutter)
'Zeilennummer in Spalte A = 1 eintragen
Cells(lStart, 1) = arrText(0)
'Trennzeichen (
strCutter = "("
'Suchwort abtrennen
arrText = Split(arrText(1), strCutter)
'Suchwort in Spalte B = 2 eintragen
Cells(lStart, 2) = Trim(arrText(0))
'zu uebernehmende "Spalte" je nach Suchwort festlegen
'bea: Array faengt mit Index 0 an
If Trim(arrText(0)) = strSearch1 Then iCol = 3 Else iCol = 7
'Trennzeichen ,
strCutter = ","
'Resttext aufteilen
arrText = Split(arrText(1), strCutter)
'Resttext in Spalte C eintragen
With Cells(lStart, 3 + Abs(1 * (InStr(strLine, strSearch2) = 0)))
'Resttext eintragen
.Value = arrText(iCol)
'Punkt durch Komma ersetzen
'Hinweis: wegen englischem VBA Punkt durch Punkt
.Replace What:=".", Replacement:="."
'Ende Mit dem Bereich ab Spalte C
End With
'Zeile 1 erhöhen
If InStr(strLine, strSearch1) > 0 Then lStart = lStart + 1
'Ende nur importieren wenn strSearch vorhanden
End If
'Ende Schleife bis Dateiende
Loop
'Datei schließen.
Close #1
End Sub
Ich habe dazu folgende Änderungen eingebracht:
Hier habe ich die Spaltenberechnung eingefügt:
With Cells(lStart, 3 + Abs(InStr(strLine, strSearch2) = 0))
Die Zeilennummer erhöhe ich nur noch, wenn der Suchstring strSearch1 vorkommt:
If InStr(strLine, strSearch1) > 0 Then lStart = lStart + 1
Ich hab den zwar als 1 definiert, aber im ifc ist das der zweite und damit letzte von den beiden.
Wenn Du nun noch mehr Klassen importieren willst, musst Du die Suchstrings entsprechend erweitern.
Das beginnt mit
Dim strSearch3$
setzt sich fort mit
strSearch3 = "irgendwas"
geht weiter mit
If InStr(strLine, strSearch1) > 0 Or InStr(strLine, strSearch2) > 0 Or InStr(strLine, strSearch3) > 0 Then
muss auch hier rein, allerdings etwas anders
alt
With Cells(lStart, 3 + Abs((InStr(strLine, strSearch2) = 0)))
neu (ungetestet)
With Cells(lStart, 3 + Abs(1 * (InStr(strLine, strSearch1) > 0)) + Abs(2 * (InStr(strLine, strSearch1) > 0)))
und wenn der Suchstring strSearch1 nicht mehr der letzte ist, sondern z.B. der strSearch3, muss es auch hier geändert werden
If InStr(strLine, strSearch3) > 0 Then lStart = lStart + 1
Das Ganze funktioniert aber nur, wenn alle Suchstrings pro Bereich jeweils maximal ein mal kommen und der für den Zeilenwechsel verantwortliche dabei der letzte im Bereich ist.