Teile aus TXT-Datei in entsprechende Excel-Felder kopieren

Hallo Experten,

ich würde gern folgendes realisieren:

Die Felder A1-A9 in einem Excel-Sheet wurden von mir schon angelegt und mit Seat 1-9 bezeichnet. Nun möchte ich gern automatisch aus dieser Textdatei

1. die Namen der Spieler den Seats zugewiesen bekommen. Und zwar in die Felder B1-B9.

2.Der Chipstand des jeweiligen Spielers in C1-C9 eingeordnet werden.

3. Die Zahl nach "Big Blind" in ein beliebiges Excel-Feld eingefügt werden, z. B. in D1

So soll das Ganze dann aussehen:

Nun passiert noch folgendes: Die Textdatei verändert sich ständig, es werden immer wieder Daten hinzugefügt, und zwar genau nach dieser Struktur. Die Chipstände der Spieler ändern sich somit ständig. Ich möchte nun, am besten mit einer Art Klickbutton, den Kopiervorgang automatisch starten, so dass sich das Excelblatt stäändig mit der Textdatei wandelt und immer den aktuellsten Stand übernimmt.

Vielen Dank für Eure Rückmeldungen und Lösungen

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 208526

Url: https://administrator.de/forum/teile-aus-txt-datei-in-entsprechende-excel-felder-kopieren-208526.html

Ausgedruckt am: 23.04.2025 um 06:04 Uhr

8 Kommentare

Neuester Kommentar

Hallo grasihuepfer. Willkommen im Forum!
auf die schnelle sollte das hier in Excel VBA funktionieren:
in Zeile 2 noch den Pfad zur Textdatei angeben...

Sub Players()
    textfilepath = "C:\test.txt"  
    Set fso = CreateObject("Scripting.Filesystemobject")  
    Set txt = fso.OpenTextFile(textfilepath, 1)
    strText = txt.ReadAll()
    txt.Close

    Set myRegExp = CreateObject("vbscript.regexp")  
    myRegExp.IgnoreCase = True
    myRegExp.Global = True
    myRegExp.Pattern = "(Seat \d:) (.*) \(\$(\d+)"  
    counter = 0
    'Seats regex  
    Set myMatches = myRegExp.Execute(strText)
    For Each myMatch In myMatches
        If myMatch.SubMatches.Count >= 1 Then
            seat = myMatch.SubMatches(0)
            spieler = myMatch.SubMatches(1)
            chips = myMatch.SubMatches(2)
            Worksheets(1).Range("A1").Offset(counter, 0).Value = seat  
            Worksheets(1).Range("A1").Offset(counter, 1).Value = spieler  
            Worksheets(1).Range("A1").Offset(counter, 2).Value = chips  
            counter = counter + 1
        End If
    Next
    'Big Blind RegEx  
    myRegExp.Pattern = "big blind \$(\d+)"  
    Set myMatches = myRegExp.Execute(strText)
    bigblind = ""  
    If myMatches.Count >= 1 Then
        bigblind = myMatches(0).SubMatches(0)
    End If
    Worksheets(1).Range("D1").Value = bigblind  
End Sub

Grüße Uwe

Hallo Uwe!

Vielen Dank für Deine Hilfe.Leider passiert nichts beim Einfügen der VBA-Funktion. Die Zahlen sind übrigens alle rot. Ist das normal? Was muss ich in den Einstellungen beachten bzw. kann ich den Text überhaupt direkt so rein-kopieren?

och nö ..... dafür gibt es doch den Quelltext Button oben rechts des Code-Feldes um nur den reinen Code zu kopieren! Die Zahlen gehören natürlich nicht dazu !!!!!!

Hi Uwe,

ich habe es jetzt ohne die Zahlen versucht. Leider ohne Erfolg. In der Excel passiert garnichts. Ich habe mal den VBAcode hier reinkopiert und hinter die Wörter, die sich farblich verändert haben, die entsprechende Farbe in Klammer dahinter geschrieben. Vielleicht findenst Du so noch die Lösung.

Danke und Gruß Jens

Sub (blau)Players()
    textfilepath = "C:\Users\Jens\Desktop\Test\test small.txt"  
    Set(blau) fso = CreateObject("Scripting.Filesystemobject")  
    Set(blau) txt = fso.OpenTextFile(textfilepath, 1)
    strText = txt.ReadAll()
    txt.Close

    Set myRegExp = CreateObject("vbscript.regexp")  
    myRegExp.IgnoreCase = True(blau)
    myRegExp.Global = True(blau)
    myRegExp.Pattern = "(Seat \d:) (.*) \(\$(\d+)"  
    counter = 0
    'Seats regex(grün)  
    Set(blau) myMatches = myRegExp.Execute(strText)
    For Each(blau) myMatch In (blau)myMatches
        If (blau)myMatch.SubMatches.Count >= 1 Then(blau)
            seat = myMatch.SubMatches(0)
            spieler = myMatch.SubMatches(1)
            chips = myMatch.SubMatches(2)
            Worksheets(1).Range("A1").Offset(counter, 0).Value = seat  
            Worksheets(1).Range("A1").Offset(counter, 1).Value = spieler  
            Worksheets(1).Range("A1").Offset(counter, 2).Value = chips  
            counter = counter + 1
        End If(blau)
    Next(blau)
    'Big Blind RegEx(grün)  
    myRegExp.Pattern = "big blind \$(\d+)"  
        Set myMatches = myRegExp.Execute(strText) 
bigblind = ""   
 If myMatches.Count >= 1 Then (blau)
bigblind = myMatches(0).SubMatches(0) 
End If 
Worksheets(1).Range("D1").Value = bigblind   
End Sub


Private Sub (blau) Worksheet_Activate()

End Sub (blau)

Private Sub (blau)Worksheet_SelectionChange(ByVal(blau) Target As Range)

End Sub(blau)

[Edit Biber]Pseudocode in Pseudocodetags gesetzt. [/Edit]

OK ich glaube du brauchst erst mal einen Grundkurs VBA dann wüsstest du nämlich wissen das die Blaufärbung kein Fehler ist sondern die Markierung der VBA Schlüsselwörter.
Und klar passiert erst mal nichts nachdem du den Code eingefügt hast, du must ihn ja erst explizit starten, entweder den Cursor in dem Makro platzieren und dann F5 drücken, oder einer Schaltfläche das Makro zuweisen.
Danach zurück in auf die erste Tabelle wechseln und sehen was extrahiert wurde.
P.S. die Lösung muss ich nicht erst finden, die steht schon in meinem ersten Kommentar in Form des Codes der einwandfrei funktioniert wenn man ihn denn richtig anzuwenden weiß. Ich möchte nicht unhöflich erscheinen aber das hier ist ein Administrator-Forum und kein "wie bastel ich mir mein Spiel"-Forum. D.h. es sollte hier Primär um Fragestellungen gehen die Problemstellungen eines "Administrators" angehen.

Gruß Uwe
p.s. bitte den Beitrag noch als gelöst markieren. Danke.

Alles klar, danke Dir!

Ich bin doch Administrator...und zwar auf meinem PC

nein Spaß bei Seite, Ich hab mich noch nicht so intensiv mit VBA auseinandergesetzt und ehrlich gesagt etwas einfacher vorgestellt.

Hast Du für mich noch ne gute Infoseite zu dem Thema?

Danke

VBS Tutorials
http://www.google.de/search?q=vbs+tutorial

Die Objekte und Eigenschaften des jeweiligen Office Programms findest du dann in der Hilfe des VBA Editors.