Office: Referenz kopieren aus spezifischer Zeile

Hallihallo,

Ich habe hier eine sehr mühsame, repetetive Arbeit zu erledigen die man meiner Meinung nach mit dem richtigen Know-How in einer Minute hinter sich hätte.
Grundsätzlich geht es darum eine Referenz zu der passenden Rechnungsnummer zu kopieren. In der einen Datei versteckt sich die Rechnungsnummer und die dazu passende Referenz, jedoch nicht in einer eigenen Spalte, denn dann hätte ich keine Probleme damit.

Hier eine Beispielszeile der Liste worin die Referenzen eingefügt werden müssen: ( Backslash steht für eine neue Spalte)

CH10431816-525397439 / 525397439 / gesuchte Referenz / 22.11.2008 / -19 / 25.04.2008

Hier ein Beispiel des Datensatzs der die gesuchte Referenz enthält:


- <G_LINE_CLUSTER>
  <REFERENCE>13.0804.0044</REFERENCE>
  <INVOICE_DATE>13-DEC-07</INVOICE_DATE>
  <DAYS_LATE>281.645902777777777778</DAYS_LATE>
  <DAYS_LATE>281.645902777777777778</DAYS_LATE>
  <DAYS_LATE>281.645902777777777778</DAYS_LATE>
  <TRANSACTION_SOURCE>GCSS</TRANSACTION_SOURCE>
  <FINAL_DESTINATION_TEXT>Shanghai</FINAL_DESTINATION_TEXT>
  <DISPUTE>
  <INVOICE_NUMBER>CH10360308</INVOICE_NUMBER>
  <BL_NUMBER>523301224</BL_NUMBER>
  <PURCHASE_ORDER>
  <DUE_DATE>27-JAN-08</DUE_DATE>
  <TRX_DATE>17-DEC-07</TRX_DATE>
  <TRX_AMOUNT_DUE>959.45</TRX_AMOUNT_DUE>
  <FUNC_AMOUNT_DUE>1,166.60</FUNC_AMOUNT_DUE>
  </G_LINE_CLUSTER>

Danach wiederholt sich das ganze nach demselben Muster. Die gesuchte Referenz befindet sich in der zweiten Zeile.

Ich vermute man kann relativ simpel diese Daten in Spalten aufteilen oder ein Lookup anstellen, welches Excel sagt: "Entspricht der gesuchte Wert der Zeile "Invoice_Number" dann kopier mir die Zeile "Reference" vom selben Datensatz oder einfach 8 Zeilen oberhalb der übereinstimmenden Zelle"

Für mich klingt es sehr simpel, doch ich kann nicht sagen ob es auch machbar ist, denn mir fehlen einfach die Excel Kenntnisse dafür.

Die beiden Dateien habe ich bei bei einem Filehoster heraufgeladen:
xxx

Also wie gesagt, wenn mir jemand einen Tipp geben kann wenn ich den Datensatz der die gesuchte Referenz enthält in Spalten aufteilen kann wäre für mich das Problem schon gelöst. Der Rest liesse sich dann nämlich mit VLookup lösen. Wenn jemand eine Lösung kennt wie man diese Referenz direkt aus der richtigen Zeile auslesen kann... noch besser! :)

 

Du meinst den "normalen" Slash, ja? Aber diese Zeile steht so, wie Du sie gepostet hast, in einer Zeile einer Textdatei? Die Aufteilung in Spalten passiert erst in Excel?

Und über welches Feld soll das jetzt verknüpft sein? Ich finde keine übereinstimmenden Felder...

Aber diese "Tag"-Zeilen stehen auch als einzelne Zeilen in einer Textdatei? Oder steht das alles in einer Zeile hintereinander?

Gruß, Michael

 

Guten Morgen miriki,

Es ist ein bisschen verwirrend sorry, eigentlich hätte ich es mir sparen können diese Beschreibung mit dem Slash. Diese Zeile ist nämlich schon in der richtigen Form in einer Excel Tabelle. Es geht eigentlich nur um das zweite file, darin sind die Werte in Zeilenblocks a 17 Zeilen aufgeführt.
Wenn ich nur 17 markiere kann ich die relativ simpel zu Spalten umwandeln mit der Funktion "Paste Special" und dann "Transpose" (Ich benutze hier ein englisches Excel)

Die Datei worin sich die gesuchte Referenz befindet sieht so aus:

[/URL]

Habe übrigens die beiden Files bei Megaupload gehostet, am einfachsten wäre es wenn du dir die mal schnell anschaust.

 

Hab ich dann mal gemacht... ;-)

Ich hab im ersten Anlauf auch was mit Formeln versucht, um die Zeilen zu zerpflücken, aber das wurde mir recht schnell zu unübersichtlich. Deswegen hab ich was in VBA gebastelt.

Dummerweise klappt es hier z.Z. ja nicht mit den Attachments, deswegen beschreibe ich es mal. Zuerst der Code, in 2 Teilen:

Code:

Option Explicit

Type t_GLINECLUSTER
  REFERENCE As String
  INVOICEDATE As String
  DAYSLATE As String
  PAYERTYPE As String
  PAYMENTTYPE As String
  TRANSACTIONSOURCE As String
  FINALDESTINATIONTEXT As String
  DISPUTE As String
  INVOICENUMBER As String
  BLNUMBER As String
  PURCHASEORDER As String
  DUEDATE As String
  TRXDATE As String
  TRXAMOUNTDUE As String
  FUNCAMOUNTDUE As String
End Type

Type t_GLINE
    TAG1 As String
    VAL1 As String
    TAG2 As String
End Type

Code:

Option Explicit

Const sht_xml = "Tabelle1"
Const sht_tbl = "Tabelle2"

Private Function Xml2Tag(s$) As String
'holt sich den 1. tag aus einer xml-zeile, egal was danach noch folgt

    Dim r As String
    Dim p1 As Long: Dim p2 As Long

    r = ""
    p1 = InStr(1, s, "<vbTextCompare> 0) Then
        p2 = InStr(p1, s, ">", vbTextCompare)
        If (p2 > 0) Then
            r = Mid$(s, p1 + 1, p2 - p1 - 1)
            If Right$(r, 2) = " /" Then
                r = Left$(r, Len(r) - 2)
            End If
        End If
    End If

    Xml2Tag = r

End Function

Private Function Xml2TagValTag(s$) As t_GLINE
'teile eine kpl. xml-zeile in "tag", "wert" und "tag" auf.
'wird der ende-tag gefunden, ist der 2. tag gleich dem 1. tag
'  alles dazwischen in "wert"
'  ansonsten ist der 2. tag leer - rest in "wert"
'hat die zeile keinen wert, ist der erste tag mit / abgeschlossen
'  dann ist wert und 2. tag leer - "wert" leer

    Dim r As t_GLINE
    Dim r1 As String
    Dim r2 As String
    Dim r3 As String
    Dim p1 As Long
    Dim p2 As Long
    Dim p3 As Long

    r1 = ""
    r2 = ""
    r3 = ""

    p1 = InStr(1, s, "<vbTextCompare> 0) Then
        p2 = InStr(p1 + 1, s, ">", vbTextCompare)
        If (p2 > 0) Then
            r1 = Mid$(s, p1 + 1, p2 - p1 - 1)
            If Right$(r1, 2) = " /" Then
                r1 = Left$(r1, Len(r1) - 2)
              Else
                p3 = InStr(p2 + 1, s, "</r1> 0) Then
                    r2 = Mid$(s, p2 + 1, p3 - p2 - 1)
                    r3 = r1
                  Else
                    r2 = Right$(s, Len(s) - p2)
                End If
            End If
        End If
    End If

    r.TAG1 = r1
    r.VAL1 = r2
    r.TAG2 = r3
    Xml2TagValTag = r

End Function

Private Sub B_XML_Split_Click()

    Dim s1 As Worksheet
    Dim s2 As Worksheet
    Dim GLINECLUSTER As t_GLINECLUSTER
    Dim GLINE As t_GLINE
    Dim y1 As Long: Dim x1 As Long: Dim tst1 As String
    Dim y2 As Long: Dim x2 As Long
    Dim dsm As Boolean
    Dim xmls As String: Dim xmlt As String
    Dim s As String

    Set s1 = Worksheets(sht_xml)
    Set s2 = Worksheets(sht_tbl)

    s2.Cells.ClearContents
    s2.Cells.ClearFormats
    y2 = 1
    For x2 = 1 To 15
        Select Case x2
            Case 1
                s = "REFERENCE"
            Case 2
                s = "INVOICE_DATE"
            Case 3
                s = "DAYS_LATE"
            Case 4
                s = "PAYER_TYPE"
            Case 5
                s = "PAYMENT_TYPE"
            Case 6
                s = "TRANSACTION_SOURCE"
            Case 7
                s = "FINAL_DESTINATION_TEXT"
            Case 8
                s = "DISPUTE"
            Case 9
                s = "INVOICE_NUMBER"
            Case 10
                s = "BL_NUMBER"
            Case 11
                s = "PURCHASE_ORDER"
            Case 12
                s = "DUE_DATE"
            Case 13
                s = "TRX_DATE"
            Case 14
                s = "TRX_AMOUNT_DUE"
            Case 15
                s = "FUNC_AMOUNT_DUE"
        End Select
        s2.Cells(y2, x2).Value = s
    Next x2

    dsm = False
    y1 = 1: x1 = 1
    s1.Activate: ActiveSheet.Cells(y1, x1).Activate
    tst1 = Trim$(s1.Cells(y1, x1).Value)
    'liste bis zum ende durchlaufen
    While (tst1 <> "")

        'zeile lesen
        xmls = Trim$(s1.Cells(y1, 1).Value)
        xmlt = Xml2Tag(xmls)

        Select Case xmlt
            Case "G_LINE_CLUSTER"
                GLINECLUSTER.REFERENCE = ""
                GLINECLUSTER.INVOICEDATE = ""
                GLINECLUSTER.DAYSLATE = ""
                GLINECLUSTER.PAYERTYPE = ""
                GLINECLUSTER.PAYMENTTYPE = ""
                GLINECLUSTER.TRANSACTIONSOURCE = ""
                GLINECLUSTER.FINALDESTINATIONTEXT = ""
                GLINECLUSTER.DISPUTE = ""
                GLINECLUSTER.INVOICENUMBER = ""
                GLINECLUSTER.BLNUMBER = ""
                GLINECLUSTER.PURCHASEORDER = ""
                GLINECLUSTER.DUEDATE = ""
                GLINECLUSTER.TRXDATE = ""
                GLINECLUSTER.TRXAMOUNTDUE = ""
                GLINECLUSTER.FUNCAMOUNTDUE = ""
                dsm = True
            Case "/G_LINE_CLUSTER"
                y2 = y2 + 1
                For x2 = 1 To 15
                    Select Case x2
                        Case 1
                            s = GLINECLUSTER.REFERENCE
                        Case 2
                            s = GLINECLUSTER.INVOICEDATE
                        Case 3
                            s = GLINECLUSTER.DAYSLATE
                        Case 4
                            s = GLINECLUSTER.PAYERTYPE
                        Case 5
                            s = GLINECLUSTER.PAYMENTTYPE
                        Case 6
                            s = GLINECLUSTER.TRANSACTIONSOURCE
                        Case 7
                            s = GLINECLUSTER.FINALDESTINATIONTEXT
                        Case 8
                            s = GLINECLUSTER.DISPUTE
                        Case 9
                            s = GLINECLUSTER.INVOICENUMBER
                        Case 10
                            s = GLINECLUSTER.BLNUMBER
                        Case 11
                            s = GLINECLUSTER.PURCHASEORDER
                        Case 12
                            s = GLINECLUSTER.DUEDATE
                        Case 13
                            s = GLINECLUSTER.TRXDATE
                        Case 14
                            s = GLINECLUSTER.TRXAMOUNTDUE
                        Case 15
                            s = GLINECLUSTER.FUNCAMOUNTDUE
                    End Select
                    s2.Cells(y2, x2).Value = s
                Next x2
                dsm = False
            Case Else
                If dsm Then
                    GLINE = Xml2TagValTag(xmls)
                    Select Case GLINE.TAG1
                        Case "REFERENCE"
                            GLINECLUSTER.REFERENCE = GLINE.VAL1
                        Case "INVOICE_DATE"
                            GLINECLUSTER.INVOICEDATE = GLINE.VAL1
                        Case "DAYS_LATE"
                            GLINECLUSTER.DAYSLATE = GLINE.VAL1
                        Case "PAYER_TYPE"
                            GLINECLUSTER.PAYERTYPE = GLINE.VAL1
                        Case "PAYMENT_TYPE"
                            GLINECLUSTER.PAYMENTTYPE = GLINE.VAL1
                        Case "TRANSACTION_SOURCE"
                            GLINECLUSTER.TRANSACTIONSOURCE = GLINE.VAL1
                        Case "FINAL_DESTINATION_TEXT"
                            GLINECLUSTER.FINALDESTINATIONTEXT = GLINE.VAL1
                        Case "DISPUTE"
                            GLINECLUSTER.DISPUTE = GLINE.VAL1
                        Case "INVOICE_NUMBER"
                            GLINECLUSTER.INVOICENUMBER = GLINE.VAL1
                        Case "BL_NUMBER"
                            GLINECLUSTER.BLNUMBER = GLINE.VAL1
                        Case "PURCHASE_ORDER"
                            GLINECLUSTER.PURCHASEORDER = GLINE.VAL1
                        Case "DUE_DATE"
                            GLINECLUSTER.DUEDATE = GLINE.VAL1
                        Case "TRX_DATE"
                            GLINECLUSTER.TRXDATE = GLINE.VAL1
                        Case "TRX_AMOUNT_DUE"
                            GLINECLUSTER.TRXAMOUNTDUE = GLINE.VAL1
                        Case "FUNC_AMOUNT_DUE"
                            GLINECLUSTER.FUNCAMOUNTDUE = GLINE.VAL1
                    End Select
                End If
        End Select

        y1 = y1 + 1: x1 = 1
        s1.Activate: ActiveSheet.Cells(y1, x1).Activate
        tst1 = Trim$(s1.Cells(y1, x1).Value)
    Wend

    s1.Cells(1, 1).Activate

    s2.Activate
    s2.Rows(1).Font.Bold = True
    s2.Columns.ColumnWidth = 1
    s2.Columns.AutoFit

End Sub

1) Neue Excel-Mappe öffnen - Es sollten die Blätter "Tabelle1" und "Tabelle2" existieren. Mehr schaden nicht, aber ggf. 2. Blatt erstellen.
2) Visual-Basic-Editor aufrufen mit Alt-F11
3) Menü "Einfügen - Modul"
Rechts im Source-Fenster den 1. Block von oben einkopieren
4) Doppelklick auf "Tabelle1 (Tabelle1)" links im Projekt-Explorer. Ist der nicht sichtbar, mittels Strgt-R aktivieren.
Im rechten Sourcefenster dann den 2. Block von oben einkopieren.
5) Zurück zu Excel selbst und "Tabelle1" aktivieren.
6) Aus der "Steuerelement-Toolbox" die "Befehlsschaltfläche" anklicken und irgendwo rechts oben auf "Tabelle1" platzieren. Ist die Toolbox nicht sichtbar, mittels Menü "Ansicht - Symbolleisten - Steuerelement-Toolbox" aktivieren.
7) Rechter Mausklick auf den neu erstellten Button und "Eigenschaften" anwählen. Im Eigenschaftsfenster dann mindestens den "(Name)" auf den Wert "B_XML_Split" setzen.
Sinnvoll wäre wohl zumindest auch noch, die "Caption" auf z.B. "Tabelle" zu setzen. Außerdem benutze ich auch gerne mal "TakeFocusOnClick" auf "False".
8) Rechter Mausklick auf den Button und "Code anzeigen" sollte jetzt in den VBA-Editor wechseln und den Cursor direkt hinter die "Sub ..." Zeile setzen. Ist die nächste Zeile ein "Dim ..." scheint alles ok, ist es ein "End ..." dann ist was schief gelaufen. ;-)

Endspurt:
9) In der "atalantic test ref1.xls" auf blatt "sheet1" die kpl. Spalte A markieren und kopieren
10) In der neuen Mappe (die mit dem Button) auf "Tabelle1" Zelle A1 markieren und rechter Mausklick darauf. "Inhalte einfügen..." und "Werte" auswählen.

Das große Finale:
11) Auf den Button klicken.
12) Zusehen, wie die Liste abgearbeitet wird.
13) Das Ergebnis auf "Tabelle2" sehen.

Ich hoffe, alles klappt so, wie beschrieben.

Gruß, Michael

 

Vielen Dank Michael!

Es scheint (halb) zu funktionieren. Bin deine Anleitung extra zweimal durchgegangen und hab jedesmal denselben Fehler bekommen sobald ich auf den Button geklickt hab:




Der Test mit dem "Code anzeigen" hat jedoch genau so funktioniert wie du es gesagt hast.

Bei der Tabelle2 wird nun die erste Zeile gefüllt, leider nicht mehr als das. Keine Werte, nur die Header falls das was hilft.

 

Ja, das ist verständlich. Die Zeile hat's nämlich irgendwie verhackstückt. Sieht so aus, als wenn "HTML deaktivieren" auch notwendig ist, wenn es um >, < und Konsorten in (code)-Blöcken geht. Hmpf...

Es dürfte noch ein paar Zeilen mehr betreffen, daher die beiden Routinen nochmal komplett mit deaktiviertem HTML:

Code:

Private Function Xml2Tag(s$) As String
'holt sich den 1. tag aus einer xml-zeile, egal was danach noch folgt

    Dim r As String
    Dim p1 As Long: Dim p2 As Long

    r = ""
    p1 = InStr(1, s, "<", vbTextCompare)
    If (p1 > 0) Then
        p2 = InStr(p1, s, ">", vbTextCompare)
        If (p2 > 0) Then
            r = Mid$(s, p1 + 1, p2 - p1 - 1)
            If Right$(r, 2) = " /" Then
                r = Left$(r, Len(r) - 2)
            End If
        End If
    End If

    Xml2Tag = r

End Function

Private Function Xml2TagValTag(s$) As t_GLINE
'teile eine kpl. xml-zeile in "tag", "wert" und "tag" auf.
'wird der ende-tag gefunden, ist der 2. tag gleich dem 1. tag
'  alles dazwischen in "wert"
'  ansonsten ist der 2. tag leer - rest in "wert"
'hat die zeile keinen wert, ist der erste tag mit / abgeschlossen
'  dann ist wert und 2. tag leer - "wert" leer

    Dim r As t_GLINE
    Dim r1 As String
    Dim r2 As String
    Dim r3 As String
    Dim p1 As Long
    Dim p2 As Long
    Dim p3 As Long

    r1 = ""
    r2 = ""
    r3 = ""

    p1 = InStr(1, s, "<", vbTextCompare)
    If (p1 > 0) Then
        p2 = InStr(p1 + 1, s, ">", vbTextCompare)
        If (p2 > 0) Then
            r1 = Mid$(s, p1 + 1, p2 - p1 - 1)
            If Right$(r1, 2) = " /" Then
                r1 = Left$(r1, Len(r1) - 2)
              Else
                p3 = InStr(p2 + 1, s, "</" & r1 & ">", vbTextCompare)
                If (p3 > 0) Then
                    r2 = Mid$(s, p2 + 1, p3 - p2 - 1)
                    r3 = r1
                  Else
                    r2 = Right$(s, Len(s) - p2)
                End If
            End If
        End If
    End If

    r.TAG1 = r1
    r.VAL1 = r2
    r.TAG2 = r3
    Xml2TagValTag = r

End Function

Gruß, Michael

 

Versteh ich das richtig, dass ich den zweiten Code ersetzen muss?

Ich vermute nicht, denn dann kriege ich folgende Fehlermeldung:
"Ambiguous name detected: B_XML_Split"

Und danach:

Compile error:
User-defined type not defined

Kannst du deine Code Korrektur vielleicht nochmal in deine Newbie Anleitung einbauen? ;)

Danke!

 

Ja, zumindest den relevanten Teil.

Klar:
a) Excel-Mappe öffnen
b) Alt-F11 zum VBA-Editor - links "Tabelle1 (Tabelle1)" Doppelklick, rechts erscheint der Source
c) den Bereich mit den beiden Routinen am Anfang markieren
1. Zeile: "Private Function Xml2Tag(s$) As String"
letzte Zeile: "End Function" - die Zeile vor "Private Sub B_XML_Split_Click()"
d) "Entf" drücken, damit bleiben oben 3 Zeilen "option explicit" und 2x "const ..." übrig, darunter die kpl. Routine "B_XML_Split_Click" und dazwischen steht der Cursor.
e) die beiden Routinen aus dem letzten Posting kopieren und dort einfügen.
Damit ist die vorherige Version der beiden ersetzt.

So sollte es dann gehen.

Gruß, Michael

 

Es funktioniert!!

Du weisst gar nicht was für einen grossen Gefallen du so nebenbei geleistet hast! Dank dir werden nun Stunden an sinnloser, nervenaufreibender und monotoner Arbeit gespart. Danke dafür!

Wenn du möchtest, dann schreib mir doch eine PN mit deiner Privatadresse, ich würde dir gerne eine Flasche Wein zukommen lassen. Wenn das nicht deinen Vorlieben entspricht auch gern was anderes!

Nochmals: DANKE!

 

HEISSA! :-)

Na, Mensch... Prima!

Ne, laß mal, das paßt schon... Hauptsache, es funktioniert. Und die im Zuge dieser Aufgabe gebastelten Routinen zum XML-Zerpflücken kann ich ja vielleicht anderweitig auch nochmal erweitern und benutzen.

Gruß, Michael