Office: txt durchsuchen & in Zelle einfügen

barni2k7 · 9. Juni 2012

Hey,

habe garde angefangen mich mit vba zu beschäftigen und habe ein Problem.

Und zwar möchte ich eine vorhanden txt datei nach bestimmten Attributen durchsuchen und danach in Excel in ein mehrdimensionales Array einfügen.

Die Attribute sehen so aus:

BO_ Indentifier Name: Länge Sender
BO_ 1111111111 status_long: 8 Karl
BO_ 1234567890 cmd_short: 16 Bernd
.
.
.

Möchte nun aus dieser Datei alle Zeilen die mit BO_ anfangen in ein Array schreiben und zwar Indentifier Name Länge und Sender in eine jeweils eine Spalte.

Hoffe das war einigermaßen verständlich ausgedrückt.

Gruß Barni

:)

EarlFred · 11. Juni 2012

Hallo Barni,

ich würde die Textdatei einfach mit Excel öffnen und im dann automatisch öffnenden Textimport-Assistenten die notwendigen Einstellungen vornehmen, damit die Spalten wie gewünscht aufgeteilt werden.
Anschließend lege einen Autofilter über die Daten, filtere alles heraus, was nicht mit den gewünschten Zeichen beginnt und lösche es heeraus.

Grüße
EarlFred

Beverly · 11. Juni 2012

Hi Barni,
Code:

Sub TextdateiAuslesen()
Dim strText As String ' Variable für die auszulesende Textzeile
Dim loText As Long ' Schleifenzähler für Textzeile
Dim loZeile As Long ' Schleifenzähler für Array
Dim arrDaten() As String
Dim arrTemp() As String
' Textdatei zum Einlesen öffnen
Open "D:\Test\Textdatei.txt" For Input As #1
' Schleife bis Dateiende
Do While Not EOF(1)
' Text zeilenweise auf die Variable schreiben
Line Input #1, strText
' der Suchbegriff ist enthalten
If InStr(strText, "BO_") > 0 Then
arrTemp = Split(strText, " ")
ReDim Preserve arrDaten(0 To 3, 0 To loZeile)
arrDaten(0, loZeile) = arrTemp(1)
arrDaten(1, loZeile) = arrTemp(2)
arrDaten(2, loZeile) = arrTemp(3)
arrDaten(3, loZeile) = arrTemp(4)
loZeile = loZeile + 1
strText = ""
Erase arrTemp
End If
' Zeilenzähler um 1 erhöhen
loText = loText + 1
Loop
' Textdatei schließen
Close #1
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

barni2k7 · 11. Juni 2012

Hallo Beverly,

habe den Code jetzt mal so eingefügt, den Dateinamen angepasst, kompliert auch ohne Fehler, jedoch steht im Excel Worksheet nichts.

Gruß Barni

Beverly · 11. Juni 2012

Hi Barni,

du hattest geschrieben, dass du den Inhalt in ein Array einlesen willst - genau das macht der Code. Vom Tabellenblatt war keine Rede.

Ergänze vor End Sub diese Codezeile:
Code:

Range("A1").Resize(UBound(arrDaten(), 2) + 1, 4) = Application.Transpose(arrDaten())
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

barni2k7 · 11. Juni 2012

Sry habs garde selber gesehen!

Danke funktioniert jetzt! :-)

CitizenX · 11. Juni 2012

Hi,

hier noch eine fixe Variante:

Code:

barni2k7 · 11. Juni 2012

Hey,

in der txt. datei kommt das Attribut noch öfters vor, jedoch benötige ich nur die Zeilen wo das BO_ am anfang steht.

CitizenX · 11. Juni 2012

Hi barni,

hast du mal meine Version getestet ?

barni2k7 · 11. Juni 2012

Jap Läuft und nimmt auch nur die wo das BO_ vorne steht...

Jedoch steht in der 4.ten Zeile beim Sender nichts

barni2k7 · 11. Juni 2012

ich meinte 4.te Spalte....

Fehler müsste in der Ausgabe des Arrays liegen weil wenn ich Sender und Länge tausche gibt er den Empfänger aus aber die Länge nicht mehr

CitizenX · 11. Juni 2012

Hi,
da hast du ja einen richtigen Rundumschlag gemacht :

Office 365 Login | Microsoft Office -loesung.de/ftopic530052_0_0_asc.php
http://www.digital-inn.de/excel-und-...tml#post157755

lies mal das hier Thema Crosspostings

IngGi · 11. Juni 2012

Hallo zusammen,

ich erlaube mir mal, Steffens Code anzupassen:

Sub getmyText()
Dim FSO As Object, oStream As Object
Dim Regex As Object, myMatch As Object, oItems As Object
Dim Filename As String
Dim myString As String, mySearch As String
Dim Out, z

' Suchbegriff der am Anfang stehen soll
mySearch = "BO_"

' Pfad der Datei -> anpassen!
Filename = "C:\Temp\Test.txt"

Set Regex = CreateObject("VBScript.RegexP")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oStream = FSO.OpenTextFile(Filename, 1)

myString = oStream.ReadAll
oStream.Close

With Regex
.Global = True
.IgnoreCase = True
.MultiLine = True

'#######################################

.Pattern = "^" & mySearch & ".+(?=\r\n)"

'#######################################

If .Test(myString) Then
Set myMatch = .Execute(myString)
ReDim Out(1 To myMatch.Count, 3)
For Each oItems In myMatch
z = z + 1

'###########################

Out(z, 0) = Split(oItems)(0)
Out(z, 1) = Split(oItems)(1)
Out(z, 2) = Split(oItems)(2)
Out(z, 3) = Split(oItems)(3)

'###########################

Next
End If
End With

' Ausgabeblatt und Zelle ggf anpassen

'##############################################################################

Sheets("Tabelle1").Cells(1, 1).Resize(UBound(Out, 1), UBound(Out, 2) + 1) = Out

'##############################################################################

Set Regex = Nothing
Set FSO = Nothing
Set oStream = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

VBA/HTML - CodeConverter für Excelforen
AddIn für Excel XP+2003 - komplett in VBA geschrieben von IngGi
Anbindung an VBE-Kontextmenü geklaut ;-) bei:
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

CitizenX · 11. Juni 2012

Hi ,

oder so :

Code:

barni2k7 · 11. Juni 2012

Guten Morgen,

grade beide Codes funktionieren fehlerfrei! Danke!!!!

Office: txt durchsuchen & in Zelle einfügen

txt durchsuchen & in Zelle einfügen

txt durchsuchen & in Zelle einfügen

txt durchsuchen & in Zelle einfügen

txt durchsuchen & in Zelle einfügen

txt durchsuchen & in Zelle einfügen

txt durchsuchen & in Zelle einfügen - Similar Threads - durchsuchen Zelle einfügen

Zelle Nach Wörtern durchsuchen und zurückgeben?

Mehrere Spalten durchsuchen und Wert von anderen Zelle ausgeben

Tabelle nach Wert durchsuchen und 2 Werte aus anderer Zelle ausgeben

zellen nach verschiedenen inhalten durchsuchen und bestimmten Wert ausgeben

Dispo Plan nach Wert Durchsuchen und verschiedene Zellen in andere Mappe kopieren

Zellen nach Stichworten durchsuchen und auflisten

VBA Tabelle durchsuchen und Zellen übertragen