Supportnet / Forum / Tabellenkalkulation

Liebe Leute! Ich übertrage Ergebnis-Listen von Sport-Wettkämpfen in pdf-Format nach Excel-Tabellen. Leider finde ich in der MS-Hilfe keinen entsprechenden Hinweis und den Text-Import-Assistenten konnte ich bisher noch nicht zur richtigen Funktion bewegen. Die in die Tabelle eingefügten Ränge, Namen, Lauf-Zeiten, Sportclubs ordnen sich immer wieder in die Spalte A ein, jedes Detail unter die darunter liegende Zelle. Beispiel: Rang....Namen..........Zeit.................Sportclub 1............Meier..........2:00:14.............Schiklub Klammer 2............Müller.........2:00:18.............Schiklub Meier 3............Schild.........2:00:34.............Schiklub Raich und so sieht es aus: Rang Namen Zeit Sportclub 1 Meier 2:00:14 Schiklub Klammer 2 Müller 2:00:18 Schiklub Meier 3 Schild 2:00:34 Schiklub Raich Mache ich was falsch, oder gibt es für meine Frage keine Lösung und ich muß also jedes Detail händisch in die entsprechende Zelle verschieben?? Danke schon mal für Eure Hilfe! Liebe Grüße Jorja

hi Jorja :-)

wie gewuenscht

gruss nighty

Option Base 1
Option Explicit
Sub Beispiel()
    Dim LzeileA As Long, Zaehler0 As Long, Zaehler1 As Long, Zaehler2 As Long
    LzeileA = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
    ReDim ArrayNeu(LzeileA, 4) As Variant
    ReDim ArrayA(LzeileA, 1) As Variant
    ArrayA() = Range("A1:A" & LzeileA)
    For Zaehler0 = 1 To UBound(ArrayA()) Step 4
        Zaehler2 = Zaehler2 + 1
        For Zaehler1 = 0 To 3
            ArrayNeu(Zaehler2, Zaehler1 + 1) = ArrayA(Zaehler0 + Zaehler1, 1)
        Next Zaehler1
    Next Zaehler0
    Range("A:A") = ""
    Range("A1:D" & LzeileA) = ArrayNeu()
End Sub

hi all :-)

wie ueblich ,korrigiert :-))

gruss nighty

Option Base 1
Option Explicit
Sub Beispiel()
    Dim LzeileA As Long, Zaehler0 As Long, Zaehler1 As Long, Zaehler2 As Long
    With ActiveSheet
    LzeileA = .Range("A" & Rows.Count).End(xlUp).Row
    ReDim ArrayNeu(Round(LzeileA / 4), 4) As Variant
    ReDim ArrayA(LzeileA, 1) As Variant
    ArrayA() = Range("A1:A" & LzeileA)
    For Zaehler0 = 1 To UBound(ArrayA()) Step 4
        Zaehler2 = Zaehler2 + 1
        For Zaehler1 = 0 To 3
            ArrayNeu(Zaehler2, Zaehler1 + 1) = ArrayA(Zaehler0 + Zaehler1, 1)
        Next Zaehler1
    Next Zaehler0
    .Range("A:A") = ""
    .Range("A1:D" & Round(LzeileA / 4)) = ArrayNeu()
    End With
End Sub

Vielen Dank!

Aber oh jeh,
was mache ich damit?

Leider sagt mir das nichts.
vielleicht kann man da eine Art Bedienungsanleitung hinzufügen?

Liebe Grüße

Jorja

hi Jorja

alt+f11/einfuegen/modul/code einfuegen

mit f5 wird er gestartet,nun sind deine daten sortiert

gruss nighty

hi Jorja

nach dem einfuegen koennte man eine taste zuweisen
im excel menue
extra/makro/makros/auswaehlen/optionen

gruss nighty

hi all

nach austausch von emails ergab sich dann diese loesung

gruss nighty

' spalte a ist durch import einer pdf datei mit datensaetzen befuellt worden
' zeile 1-8 beliebiger text bzw kopf zeilen
' datensaetze die zwichen 2 und 5 zeilen haben,beinhalten eine uhrzeit auf der die pruefung bzw isolierung eines datensatzes erfolgt
' neu sortiert in ein array gelegt
' befuellung durch ein array der spalten a bis e,maximum 5
' durch falsch darstellung mussten folgende spalten neu formatiert werden
' a als ganzzahl,wie b als 6 stellige uhrzeit

' zeile 9 muss der begin der datensaetze sein
' gegebenfalls 1-8 zeilen auffuellen,falls sich die anzahl aendern sollte
' die erste zeitangabe muss zeile 10 sein
' ausgehend von obiger startposition
' erfolgt nun eine neugestaltung mit automatische abtastung der uhrzeit bezugnehmend der datensaetze bei maximum von 5 spalten
Option Explicit
Sub PdfSortieren()
    Dim Zaehler0 As Long, Zaehler1 As Long, Zaehler2 As Long, Zaehler3 As Long, pos1 As Long, pos2 As Long, LzeileA As Long
    Dim schalter As Boolean
    With ActiveSheet
        LzeileA = .Range("A" & Rows.Count).End(xlUp).Row
        ReDim ArrayNeu(LzeileA, 6) As Variant
        ReDim ArrayA(LzeileA, 1) As Variant
        .Rows("1:8").Delete Shift:=xlUp
        ArrayA() = Range("A1:A" & LzeileA)
        pos1 = 2
        For Zaehler0 = 3 To LzeileA
            If Len(ArrayA(Zaehler0, 1)) > 1 Then
                If Mid(ArrayA(Zaehler0, 1), 2, 1) = "," Then
                    pos2 = Zaehler0
                    Zaehler3 = 0
                    For Zaehler1 = pos1 - 1 To pos2 - 2
                        ArrayNeu(Zaehler2, Zaehler3) = ArrayA(Zaehler1, 1)
                        Zaehler3 = Zaehler3 + 1
                    Next Zaehler1
                    Zaehler2 = Zaehler2 + 1
                    pos1 = Zaehler0
                End If
            End If
        Next Zaehler0
        .Cells(1, 1) = "Rang"
        .Cells(1, 2) = "Zeit"
        .Cells(1, 3) = "Nr."
        .Cells(1, 4) = "Name"
        .Cells(1, 5) = "Verein/Wohnort"
        .Range("A2:A" & Rows.Count) = ""
        .Range("A2:F" & LzeileA + 1) = ArrayNeu()
        .Columns("A:A").NumberFormat = "0"
        .Columns("B:B").NumberFormat = "[h]:mm:ss"
    End With
End Sub

• Mit Excel einen txt Import aufbereiten
• Import von Excel nach Excel ohne Öffnen der Quelldatei
• Import von Excel Daten in Excel
• Import aus excel