Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
908to912
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
908to912
908to912
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Excel nach Inhalt per VBA umschreiben

Excel nach Inhalt per VBA umschreiben
27.09.2007 15:15:40
Thomas
Hallo,
Ich habe hier keinen Plan wie ich das lösen soll:
Ich habe folgende Daten als Excel-Sheet welche umsortiert werden sollen.
LINK: https://www.herber.de/bbs/user/46389.xls
Ich benötige pro ID (Spalte 1) (welche sortiert mehrfach vorkommen) eine Zeile mit den Inhalten der gleichen ID's am Ende der Zeile.
Die Abfrage müsste meines Erachtens so gehen:
Zeile 1 Feld ID merken im Speicher dann ganze Zeile rausschreiben in Zeile 1 in neue Tabelle4
Zeile 2 Feld ID gleich vorhergehendes Feld dann Feld TEXT und BETRAG appenden an Zeile 1 in Tabelle4
Zeile 3 Feld ID gleich vorhergehendes Feld dann Feld TEXT und BETRAG appenden an Zeile 1 in Tabelle4
Zeile 4 Feld ID ungleich vorhergehendes Feld dann Zeile rausschreiben in Zeile 2 in Tabelle4
and so on
Kann mir da jemand die richtigen Codeschnippsel für ein Makro verraten?
Herzlichen Dank
Thomas Leitner

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Sollen denn immer ALLE Spalten (A:L) kopiert...
27.09.2007 15:31:00
NoNet
...werden ?
Hallo Thomas,
die Zeilen enthalten ja pro ID immer unterschiedliche Daten in Spalten C und D, alle anderen Spalten sind bei gleicher ID identisch.
Genügt es, die Spalten A:B und E:L immer nur 1x zu kopieren und bei wiederholender ID nur die Spalten C:D anzuhängen ?
Du weißt aber schon, dass Excel (bis Version 2003) nur max. 256 Spalten hat, oder ?
Gruß, NoNet

AW: Sollen denn immer ALLE Spalten (A:L) kopiert...
27.09.2007 15:51:30
Thomas
Hallo NoNet,
vielen Dank für die rasche Antwort.
"Genügt es, die Spalten A:B und E:L immer nur 1x zu kopieren und bei wiederholender ID nur die Spalten C:D anzuhängen ?"
Ja es genügt völlig die relevanten Zellen hinten anzuhängen.
Übrigens das Excel Sheet hat über 4000 Zeilen !
"Du weißt aber schon, dass Excel (bis Version 2003) nur max. 256 Spalten hat, oder ?"
Jetzt schon...... ;-) Es sind aber derzeit max. 5 Positionen pro ID.
mfg Thomas Leitner

Anzeige
Liste umsortieren per VBA (ohne ARRAYS)
27.09.2007 16:38:22
NoNet
Hallo Thomas,
ich habe Dein "TOOL" mal ein wenig umprogrammiert, es heißt nun "TOLL" ;-) :


Sub TOLL()
    'Das TOOL in einer Version von NoNet (www.excelei.de), 27.09.2007 bei herber.de
    Dim shDaten As Worksheet, shListe As Worksheet
    Dim Zeile, Zeilen, zeNeu, spNeu
    Dim IDgefunden
    Set shDaten = Sheets("Tabelle1") 'Dies ist das Ursprungsblatt
    Set shListe = Sheets.Add         'Das ist das neue Blatt
    shDaten.[1:1].Copy shListe.[A1]  'Überschriften kopieren
    zeNeu = 1
    On Error Resume Next 'falls ID noch nicht gefunden wurde
    Zeilen = shDaten.Cells(Rows.Count, "A").End(xlUp).Row 'Anzahl Zeilen ermitteln
    For Zeile = 2 To Zeilen 'In Zeile 1 steht die Überschrift
        IDgefunden = 0
        IDgefunden = Application.WorksheetFunction.Match(shDaten.Cells(Zeile, "A"), _
            shListe.[A:A], 0)
        If IDgefunden > 0 Then
            spNeu = shListe.Cells(IDgefunden, Columns.Count).End(xlToLeft).Column
            shDaten.Cells(Zeile, "C").Resize(1, 2).Copy shListe.Cells(IDgefunden, spNeu + 1)
            shDaten.[B1:C1].Copy shListe.Cells(1, spNeu + 1)
        Else
            zeNeu = zeNeu + 1
            shDaten.Rows(Zeile).Copy shListe.Rows(zeNeu)
        End If
    Next
    shListe.Columns.AutoFit
    Set shDaten = Nothing
    Set shListe = Nothing
End Sub
Ich hoffe mal, das ist das, was Du wolltest ?!?!?
Gruß, NoNet

Anzeige
2 kleine Korrekturen, hier der Code
27.09.2007 17:11:00
NoNet
Hallo Thomas,
hatte versehentlich Spalten B und C anstatt C und D kopiert.
Ausserdem sieht es besser aus, wenn der erste Buchungsbetrag+Text auch hinten (vor dem 2. Betrag) erscheint, daher habe ich ihn noch per "Cut&Paste" verschoben. Hier nun der aktuelle Code :
Sub TOLL()
    'Das TOOL in einer Version von NoNet (www.excelei.de), 27.09.2007 bei herber.de
    Dim shDaten As Worksheet, shListe As Worksheet
    Dim Zeile, Zeilen, zeNeu, spNeu
    Dim IDgefunden
    Set shDaten = Sheets("Tabelle1") 'Dies ist das Ursprungsblatt
    Set shListe = Sheets.Add         'Das ist das neue Blatt
    shDaten.[1:1].Copy shListe.[A1]  'Überschriften kopieren
    zeNeu = 1
    On Error Resume Next 'falls ID noch nicht gefunden wurde
    Zeilen = shDaten.Cells(Rows.Count, "A").End(xlUp).Row 'Anzahl Zeilen ermitteln
    For Zeile = 2 To Zeilen 'In Zeile 1 steht die Überschrift
        IDgefunden = 0
        IDgefunden = Application.WorksheetFunction.Match(shDaten.Cells(Zeile, "A"), _
            shListe.[A:A], 0)
        If IDgefunden > 0 Then
            spNeu = shListe.Cells(IDgefunden, Columns.Count).End(xlToLeft).Column
            shDaten.Cells(Zeile, "C").Resize(1, 2).Copy shListe.Cells(IDgefunden, spNeu + 1)
            shDaten.[C1:D1].Copy shListe.Cells(1, spNeu + 1)
        Else
            zeNeu = zeNeu + 1
            shDaten.Rows(Zeile).Copy shListe.Rows(zeNeu)
        End If
    Next
    shListe.Columns.AutoFit
    shListe.[C:D].Cut
    shListe.[M:M].Insert Shift:=xlToRight
    Application.CutCopyMode = False
    Set shDaten = Nothing
    Set shListe = Nothing
End Sub
Schönen Feierabend,
NoNet

Anzeige
AW: 2 kleine Korrekturen, hier der Code
27.09.2007 18:10:11
Thomas
Hallo NoNet,
das Proggi ist haargenau das was ich brauche. Freu freu...
Besten Dank für die schnelle und sehr kompetente Hilfe.
Vielen Dank
Thomas Leitner

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige