grasihuepfer
Goto Top

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

ad3116483bed0b0e53feb910309b9758

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:

e2676214af0b379b67fcf9b6717cde2b

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

Content-Key: 208526

Url: https://administrator.de/contentid/208526

Printed on: April 19, 2024 at 03:04 o'clock

Member: colinardo
colinardo Jun 24, 2013 updated at 18:20:17 (UTC)
Goto Top
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
Member: grasihuepfer
grasihuepfer Jun 28, 2013 at 04:15:31 (UTC)
Goto Top
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?
Member: colinardo
colinardo Jun 28, 2013 at 06:52:54 (UTC)
Goto Top
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 !!!!!!
Member: grasihuepfer
grasihuepfer Jul 29, 2013 updated at 07:50:29 (UTC)
Goto Top
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]
Member: colinardo
colinardo Jul 29, 2013 at 05:56:43 (UTC)
Goto Top
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.
Member: grasihuepfer
grasihuepfer Jul 29, 2013 at 11:45:55 (UTC)
Goto Top
Alles klar, danke Dir!

Ich bin doch Administrator...und zwar auf meinem PC face-smile

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
Member: colinardo
colinardo Jul 29, 2013 at 11:53:26 (UTC)
Goto Top
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.
Member: grasihuepfer
grasihuepfer Jul 30, 2013 at 10:35:54 (UTC)
Goto Top
Alles Klar, prima!