quercus
Goto Top

Makro zum transponieren von Daten

Hallo bräuchte hilfe in VBA
als absoluter Neuling in VBA scripts

hab hier eine Tabelle in Excel 2007 in der in Spalten A - G daten mit gleichen Artikelnummern stehen und verschiedenen Mengen, Preisen Kunden und Lagerbeständen.

dieses sollte so transponiert werden das ab Spalte I Die Artikel Nummer steht und danach in folge die dazugehörigen Mengen,Preis,Kunde lagerbestand Artikelgruppe steht.

wenn möglich sollte auch ein Start Script schaltfläche vorhanden sein ;)

siehe Screenshot:

038024294cff2455373b661f24827b78

Gruß Quercus

Content-ID: 202575

Url: https://administrator.de/forum/makro-zum-transponieren-von-daten-202575.html

Ausgedruckt am: 26.12.2024 um 16:12 Uhr

bastla
bastla 02.03.2013 aktualisiert um 20:12:30 Uhr
Goto Top
Hallo Quercus!

Unter der Voraussetzung, dass die Quelldaten nach Artikelnummern sortiert sind (so interpretiere ich Deinen Screenshot) und es genügt, die Werte zu übertragen (BTW: "transponieren" würde bedeuten, aus Zeilen Spalten zu machen), könnte das so gehen:
Sub Uebertragen()
QUeberzeile = 1 'Zeile mit Überschrift für Quelldaten  
QAbSpalte = "A" 'Spalte, ab der die Quelldaten eingetraben sind  
Spalten = 7 'Spaltenanzahl der Quelldaten  
ZUeberZeile = 1 'Zeile für Überschriften des Zielbereichs  
ZAbSpalte = "I" 'Zielbereich beginnt in dieser Spalte  

Ueber = Cells(QUeberzeile, QAbSpalte).Resize(1, Spalten).Value 'Überschriften zwischenspeichern  

QZeile = QUeberzeile + 1 'erste Qelldatenzeile ist unmittelbar unter Überschrift  
ZZeile = ZUeberZeile 'Zieldaten werden ohne Zeilenabstand unter die Überschrift geschrieben  
ZAbSpalte = Columns(ZAbSpalte).Column 'Spalte wird in numerischer Form benötigt  

Artikel = Cells(QZeile, QAbSpalte).Value 'Artikelnummer lesen  
Do While Artikel <> "" 'Ende, wenn keine Artikelnummer mehr gefunden wird  
    If Artikel <> ArtikelVorher Then 'Wenn neue Artikelnummer, ...  
        ZZeile = ZZeile + 1 '... Zieldaten in nächste Zielzeile schreiben ...  
        ZSpalte = ZAbSpalte '... und dabei wieder in der ersten Spalte des Zielbereichs beginnen  
        ArtikelVorher = Artikel 'Artikelnummer merken  
    End If
    Cells(ZUeberZeile, ZSpalte).Resize(1, Spalten).Value = Ueber 'Überschrift für Zieldaten eintragen  
    Cells(ZZeile, ZSpalte).Resize(1, Spalten).Value = Cells(QZeile, QAbSpalte).Resize(1, Spalten).Value 'Werte aus Quellbereich in Zielbereich übernehmen  
    
    QZeile = QZeile + 1 'nächste Quelldatenzeile  
    ZSpalte = ZSpalte + Spalten 'nächste Zieldatenspalte  
    Artikel = Cells(QZeile, QAbSpalte).Value 'Artikelnummer lesen  
Loop
End Sub
Die Schaltfläche zum Starten lässt sich einfach als Grafik oder Clipart einfügen bzw als "Form" erstellen; dann nur noch per Rechtsklick "Makro zuweisen...".

Grüße
bastla

P.S.: Wozu soll die ganze Aktion eigentlich gut sein? Zumeist ist eher die gegenteilige Vorgangsweise (Stichwort "Normalisierung") gefragt ...
Quercus
Quercus 02.03.2013 um 21:13:57 Uhr
Goto Top
Danke Bastla ;)

bin gerade soweit am testen vom Makro

wozu das ganze dienen soll... nun anhand der zeilen kann ich danach rausfiltern bei welcher Artikelnummer der günstigste
Kunde im vergleich zum Ek und Vk Preis anhand der Mindestmenge zur vorhandenem Lagerbestand ist.

bei ca 30000 Gespeicherten Artikeln und zig Kunden, Lieferanten.

Grüße
Quercus
bastla
bastla 02.03.2013 aktualisiert um 21:59:17 Uhr
Goto Top
Hallo Quercus!
bei ca 30000 Gespeicherten Artikeln und zig Kunden, Lieferanten.
Ich hoffe, Dein Excel hat genügend Spalten ... face-wink

Grüße
bastla
Quercus
Quercus 03.03.2013 um 08:37:54 Uhr
Goto Top
Hi bastla,

also beim test hatte es genügend spalten face-smile

was mir noch aufgefallen ist gibt es eine möglichkeit das bevor die daten ab I reingeschrieben werden die alten daten aus diesen Spalten gelöscht werden. das wenn da wirklich noch Daten vorhanden sind das Makro auch wirklich neu reinschreiben muss?

weil gestern beim 2 testlauf ist mir aufgefallen wenn in eine spalte keine neuen daten reingeschrieben werden aber hier schon alte Daten vorhanden sind diese weiterhin bestehen bleiben.

alternativ das ganze sonst auf ein neues tabellen Blatt reinschreiben lassen das geht schneller zu löschen ;) ginge das?

Gruß

Quercus
64748
64748 03.03.2013 um 08:51:16 Uhr
Goto Top
Guten Morgen zusammen,

ich habe diesen Thread eine Weile beobachtet weil mich das Thema interessiert hat. Nun habe ich eigentlich noch nicht vollständig verstanden, was dass Ziel dieser Sache ist. Trotzdem hier eine Frage: wäre das nicht eine Aufgabe, die man einfacher mit einer Datenbank, sprich Access löst? wie hoch würdet Ihr den Lern- und Arbeitsaufwand einschätzen, um in diesem Falle die Datenbank zu erstellen, die Daten in diese zu importieren und dann die gewünschte Abfrage zu machen? Könnte sich das lohnen?

Hintergrund der Frage ist, dass die meisten Leute mit Excel relativ fit sind, die Access-Kenntnisse jedoch meist deutlich geringer.

Gruß

Markus
bastla
bastla 03.03.2013 um 14:04:28 Uhr
Goto Top
Hallo Quercus!

Mit dieser Version kannst Du die Zieldaten sowohl ins gleiche, als auch in ein anderes Blatt schreiben - gelöscht werden vorweg die Spalten von "ZAbSpalte" bis zum Blattende:
Sub Umstellen()
QTabelle = "Tabelle1" 'Quelltabelle  
QUeberzeile = 1 'Zeile mit Überschrift für Quelldaten  
QAbSpalte = "A" 'Spalte, ab der die Quelldaten eingetraben sind  
Spalten = 7 'Spaltenanzahl der Quelldaten  
ZTabelle = "Tabelle2" 'Zieltabelle  
ZUeberZeile = 1 'Zeile für Überschriften des Zielbereichs  
ZAbSpalte = "I" 'Zielbereich beginnt in dieser Spalte  

Set QTab = Worksheets(QTabelle)
Set ZTab = Worksheets(ZTabelle)
Ueber = QTab.Cells(QUeberzeile, QAbSpalte).Resize(1, Spalten).Value 'Überschriften zwischenspeichern  

QZeile = QUeberzeile + 1
ZZeile = ZUeberZeile
ZAbSpalte = Columns(ZAbSpalte).Column
ZTab.Range(ZTab.Columns(ZAbSpalte), ZTab.Columns(ZTab.Columns.Count)).ClearContents 'Spalten im Zielbereich löschen  

Artikel = QTab.Cells(QZeile, QAbSpalte).Value
Do While Artikel <> ""  
    If Artikel <> ArtikelVorher Then
        ZZeile = ZZeile + 1
        ZSpalte = ZAbSpalte
        ArtikelVorher = Artikel
    End If
    ZTab.Cells(ZUeberZeile, ZSpalte).Resize(1, Spalten).Value = Ueber
    ZTab.Cells(ZZeile, ZSpalte).Resize(1, Spalten).Value = QTab.Cells(QZeile, QAbSpalte).Resize(1, Spalten).Value
    
    QZeile = QZeile + 1
    ZSpalte = ZSpalte + Spalten
    Artikel = QTab.Cells(QZeile, QAbSpalte).Value
Loop
End Sub
Grüße
bastla
Quercus
Quercus 03.03.2013 um 14:41:42 Uhr
Goto Top
Hi bastla,


geht super face-smile


besten dank dir.

zu der frage von Hmarkus:

Hintergrund dieser ganzen Aktion ich muss aus den Einzelnen Artikeln bei einigen Kunden aus dem Ek preis anhand von Geweichtsangaben zum Artikel die dazugehörigen Zuschlags Preise herrausrechnen um danach den Ek mit dem Vk vergleichen zu können.

und wie deine Aussage ja sagt mit Excel sind mehr leute geübt als im umgang mit Access face-wink

die ganzen Daten selbst kommen aus einer SQL Datenbank wo es da schon schwierig war die einzelnen Daten herrauszubekommen.

Gruß

Quercus