MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 06.07.2014, 07:01   #16
AlexFDS
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Um 980.000...
AlexFDS ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 06.07.2014, 17:27   #17
aloys78
MOF Meister
MOF Meister
Standard

Hallo Alex,

Zitat:

Um wie viele Zeilen geht es, die so sortiert werden sollen?

Zitat:

Um 980.000...

Bei dieser Größenordnung schlage ich eine Array-basierte Lösung vor.
Nachstehend mein Vorschlag (Code in einen Modul einfügen):
Code:

Option Explicit

Sub datenStrukturieren()
    Dim ws_Q As Worksheet       'Quell-Tabelle
    Dim ws_Z As Worksheet       'Ziel-Tabelle
    Dim LoL As Long             'Nr letzte Zeile mit Inhalt
    Dim q As Long               'Zeilen# Quell-Tabelle bzw -Array
    Dim z As Long               'Index ziel-Array
    Dim s As Long               'Index 2 für Ziel-Array
    Dim arr_Q()                 'Array Quell-Daten
    Dim arr_Z()                 'Array Ziel-Daten
    Dim a As Long               'Index arr_Q
    Dim na As Long              'Anzahl Entries in arr_Q
    Dim nz As Long              'Anzahl Entries in arr_Z
    Dim sZeit As Single
    
'Initialisieren
    sZeit = Timer
    Set ws_Q = Worksheets("Quelle")
    Set ws_Z = Worksheets("Ziel")
    
'Lade Quall-Array
    With ws_Q
        LoL = .Cells(Rows.Count, "A").End(xlUp).Row
        ReDim arr_Q(0 To LoL + 1, 1 To 2)
        a = 0
        For q = 2 To LoL
            a = a + 1
            arr_Q(a, 1) = .Range("A" & q)
            arr_Q(a, 2) = .Range("B" & q)
        Next q
    End With
    na = a                      'Anzahl Entries in Quell-Tabelle

 'Sortieren nach Key (aus Sp A) u
    Call BubbleSort(arr_Q, na, 1, 1)           'Sp A - aufsteigend
    
 'Erstelle Ziel-Array
    ReDim arr_Z(0 To na + 1, 1 To 16)
    z = 0
    For q = 0 To na + 1
'ws_Z.Range("D1") = q
'ws_Z.Range("E1") = z
If q = 979 Then
q = q + 0
End If
        If arr_Q(q + 1, 1) <> arr_Q(q, 1) Then          'Spalte A-Ausdruck + max 15 Spalte B-Ausdrücke
            z = z + 1
            s = 2
        Else
            s = s + 1
            If s > UBound(arr_Z, 2) Then ReDim Preserve arr_Z(1 To na, 1 To s)      'mehr als 15 Süalte B-Ausdrücke
        End If
        arr_Z(z, 1) = arr_Q(q + 1, 1)
        arr_Z(z, s) = arr_Q(q + 1, 2)
    Next q
    nz = z
    
    With ws_Z
        .Range(.Cells(1, 1), .Cells(nz + 1, UBound(arr_Z, 2))) = arr_Z
    End With
    MsgBox Timer - sZeit
End Sub


Function BubbleSort(arr, idx_Ubound As Long, SortIndex As Long, swA As Integer)
'***********************************************************
' Sortieren 2-dimensionales Array
'***********************************************************
' arr = zu sortierendes array
' idx_Ubound = Obergrenze des zu sortierenden Array-Teils
' SortIndex = Position Sortierfeld
' swA = Sortierreihenfolge (0 = absteigend, 1 = aufsteigend)

    Dim blnNoSwaps As Boolean
    Dim lngItem As Long
    Dim vntTemp() As Variant
    Dim lngCol As Long
    ReDim vntTemp(1 To UBound(arr, 2))
    Do
        blnNoSwaps = True
        For lngItem = LBound(arr) To idx_Ubound - 1
            If (swA = 1 And arr(lngItem, SortIndex) > arr(lngItem + 1, SortIndex)) Or _
              (swA = 0 And arr(lngItem, SortIndex) < arr(lngItem + 1, SortIndex)) Then
                blnNoSwaps = False
                For lngCol = 1 To UBound(arr, 2)
                    vntTemp(lngCol) = arr(lngItem, lngCol)
                    arr(lngItem, lngCol) = arr(lngItem + 1, lngCol)
                    arr(lngItem + 1, lngCol) = vntTemp(lngCol)
                Next
            End If
        Next
    Loop While Not blnNoSwaps
End Function
Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 06.07.2014, 22:48   #18
Mc Santa
MOF Meister
MOF Meister
Standard

Hallo,

da ich parallel auch an einer neuen Antwort gebastelt habe, hier auch mein neuer Vorschlag:
Code:

Option Explicit

Sub sortData()
    Dim wsSrc As Worksheet, wsTar As Worksheet
    Dim rng As Range
    Dim lastRow As Long
    Dim col As Collection
    
    Set col = New Collection
    Set wsSrc = ThisWorkbook.Worksheets("Quelldaten")
    Set wsTar = ThisWorkbook.Worksheets("Ausgabeblatt")
    
    lastRow = wsSrc.Cells(Rows.Count, 1).End(xlUp).Row
    
    wsTar.Cells.ClearContents
    For Each rng In wsSrc.Range(Cells(1, 1), Cells(lastRow, 1))
        
        On Error Resume Next
        col.Add wsTar.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row, rng.Value
        If Err Then
            Err.Clear
            wsTar.Cells(col.Item(rng.Value), 1).End(xlToRight).Offset(, 1) = rng.Offset(, 1).Value
        Else
            wsTar.Cells(col.Item(rng.Value), 1).Resize(, 2) = Array(rng.Value, rng.Offset(, 1).Value)
        End If
        On Error GoTo 0
        Application.StatusBar = "Das Makro arbeitet... Aktueller Stand: " & Format(rng.Row / lastRow, "0.00%")
    Next rng
    Application.StatusBar = False
End Sub
VG
Angehängte Dateien
Dateityp: xlsm Daten aufteilen_V2.xlsm (19,2 KB, 7x aufgerufen)
Mc Santa ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 07.07.2014, 09:54   #19
AlexFDS
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Ich bin überwältigt. Hätte niemals gedacht, dass mir hier so geholfen wird. Vielen vielen Dank!

Nun ein kurzer Zwischenstand:

Alois, Deine Datei hat bei mir bis auf einen kleinen Fehler (die erste Zeile wird nicht erfasst) tadellos bei einer Testdatenmenge funktioniert. Bei den 980.000 Spalten hat der Rechner nach 8 Stunden noch nichts ausgespuckt, was aber wohl eher an meinem MacBookPro liegt.

Santa, Deine Datei rechnet er seit 20 Minuten. Ich bin gespannt. Drückt mir die Daumen!
AlexFDS ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 07.07.2014, 10:01   #20
Mc Santa
MOF Meister
MOF Meister
Standard

Hallo,

Ok, danke schon einmal für dein Feedback, kannst ja dann Bescheid sagen, obs geklappt hat

Brauchst du dieses Makro einmalig oder häufiger? Wenn du das oft ausführen musst, würde ich noch einmal versuchen eine schnellere Variante programmieren, in der Excel nicht so viele Zellzugriffe benötigt.

VG
Mc Santa ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 07.07.2014, 10:38   #21
aloys78
MOF Meister
MOF Meister
Standard

Hallo Alex,

Zitat:

Alois, Deine Datei hat bei mir bis auf einen kleinen Fehler (die erste Zeile wird nicht erfasst) tadellos bei einer Testdatenmenge funktioniert.

Deine Daten beginnen dann in Zeile 1 statt 2; das wäre leicht zu korrigieren.

Zitat:

Bei den 980.000 Spalten hat der Rechner nach 8 Stunden noch nichts ausgespuckt, was aber wohl eher an meinem MacBookPro liegt.

Du meinst sicherlich Zeilen.
Also - bei meinem Win 7 Rechner, der sicherlich nicht der schnellste ist, waren es bei 980.000 Zeilen (Sp A und B) 32 Sekunden.

Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 07.07.2014, 14:44   #22
AlexFDS
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Also, nochmal ich. Langsam ist es mir peinlich...

Die Berechnung von Santas Code hat ca. 4 Stunden gedauert und am Ende ist leider nur ein leeres Tabellenblatt erschienen. Mist, ich dachte das wäre die Lösung.

Aloys, das ist aber komisch, dass das bei mir so lange dauert.

Hm, was schlagt ihr vor?
AlexFDS ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 07.07.2014, 14:49   #23
Mc Santa
MOF Meister
MOF Meister
Standard

Hallo,

ich weiß leider nicht wieso es bei den vielen Daten nicht geht, obwohl es im Kleinen funktioniert.
Kannst du deine Datei zur Verfügung stellen, damit wir den Code selbst an den Daten testen können?

VG
Mc Santa ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 07.07.2014, 15:20   #24
aloys78
MOF Meister
MOF Meister
Standard

Hallo Alex,

da kann ich dem Kollegen Mc Santa nur zustimmen: wir brauchen deine Daten.

Denn ich hatte mir mit ein paar Zeilen VBA-Code eine Datei mit über 980.000 Zeilen nach deinen Regeln erstellt und dann damit getestet.

Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 07.07.2014, 21:31   #25
AlexFDS
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo zusammen,

leider ist die Datei 170mb groß und ich müsste ehrlicherweise auch erst meinen Prof fragen, ob ich die Daten rausgeben darf (sorry, komme mir richtig komisch vor). Ich weiß jetzt aber auch woran es liegt. Bei mir sind in den Zellen ausschließlich Zahlen, bei euch sind es Worte und Buchstaben. Ersetze ich meine Zahlen durch Buchstaben geht es. Allerdings geht es nicht, wenn ich die Zellen als Text formatiere.

Hoffe ihr seid nicht sauer. Kann ich irgendwie meine Dankbarkeit zeigen?
AlexFDS ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 07.07.2014, 21:44   #26
Mc Santa
MOF Meister
MOF Meister
Standard

Hallo,

Kannst du vielleicht mal ca 50 Zeilen hier hochladen? Vielleicht kannst du die Daten so verändern, dass man nicht mehr erkennt, was es ist. Aber vorsicht, dass die ART der Daten sich nicht verändert

Eigentlich sollte es kein Problem sein, dass es bei dir Zahlen sind, aber der Teufel steckt ja bekanntlich im Detail.
Ich hoffe wir kommen noch zu einer Lösung

VG
Mc Santa

Wegen bedanken: Du kannst gute oder hilfreiche Beiträge unten links bewerten (drei kleine Symbole). Ich freue mich da immer!
Mc Santa ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2014, 07:46   #27
AlexFDS
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Vielen Dank,

hier mal ein Beispiel.
Angehängte Dateien
Dateityp: xlsx Arbeitsmappe1.xlsx (35,4 KB, 8x aufgerufen)
AlexFDS ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2014, 11:04   #28
aloys78
MOF Meister
MOF Meister
Standard

Hallo Alex,

anbei das Ergebnis mit meinem Lösungsvorschlag.
Ich gebe im Moment die Daten sortiert nach den Werten in Spalte A aus, da bisher hierzu noch keine Vorgabe bestand.

Gruß
Aloys
Angehängte Dateien
Dateityp: xlsm AlexFDS_Arbeitsmappe1.xlsm (27,8 KB, 8x aufgerufen)
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2014, 11:13   #29
Mc Santa
MOF Meister
MOF Meister
Standard

Hallo,

anbei noch einmal mein angepasster Code, allerdings sollte die Variante von Aloys schneller sein. Mein Code dauert etwa 20min, unten in der Statusleiste läuft eine Prozent-Angabe mit.
Code:

Sub sortData()
    Dim wsSrc As Worksheet, wsTar As Worksheet
    Dim rng As Range
    Dim lastRow As Long
    Dim col As Collection
    
    Set col = New Collection
    Set wsSrc = ThisWorkbook.Worksheets("Quelle")
    Set wsTar = ThisWorkbook.Worksheets("Ziel")
    
    lastRow = wsSrc.Cells(Rows.Count, 1).End(xlUp).Row
    
    wsTar.Cells.ClearContents
    Application.ScreenUpdating = False
    For Each rng In wsSrc.Range(wsSrc.Cells(1, 1), wsSrc.Cells(lastRow, 1))
        
        On Error Resume Next
        col.Add wsTar.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row, CStr(rng.Value)
        If Err Then
            Err.Clear
            wsTar.Cells(col.Item(CStr(rng.Value)), 1).End(xlToRight).Offset(, 1) = rng.Offset(, 1).Value
        Else
            wsTar.Cells(col.Item(CStr(rng.Value)), 1).Resize(, 2) = Array(rng.Value, rng.Offset(, 1).Value)
        End If
        On Error GoTo 0
        Application.StatusBar = "Das Makro arbeitet... Aktueller Stand: " & Format(rng.Row / lastRow, "0.00%")
    Next rng
    Application.ScreenUpdating = True
    Application.StatusBar = False
End Sub
VG
Mc Santa ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2014, 16:14   #30
aloys78
MOF Meister
MOF Meister
Standard

Hallo Alex,

und hier der Lösungsvorschlag für den Fall, dass die Reihenfolge der Begriffe in Spalte A in der Ergebnisdarstellung gleich sein soll.

Gruß
Aloys
Angehängte Dateien
Dateityp: xlsm AlexFDS_Arbeitsmappe1 V2.xlsm (31,5 KB, 8x aufgerufen)
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 22:29 Uhr.



Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.