Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1612to1616
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
Inhaltsverzeichnis

VBA Werte transponieren oder direkt übertragen

VBA Werte transponieren oder direkt übertragen
06.03.2018 14:32:46
Axel
Hallo zusammen,
in der mitgesandten Datei
https://www.herber.de/bbs/user/120237.xlsx
ist auszugsweise oben die Datenbasis und darunter das Zielbild, das in ein anderes Tabellenblatt übertragen werden soll.
Roter Kasten: die Daten wiederholen sich in der Datenbasis untereinander mehrfach
Rot durchkreuzt: diese Daten werden nicht mit übertragen
Die Produkte, die in der Datenbasis untereinander stehen, sollen im Zieltabellenblatt nebeneinander stehen. Zu beachten ist, dass unterschiedliche Produkte die Volumina in unterschiedlichen Spalten ausweisen (max 3 Spalten).
Bisher habe ich das mehr oder weniger händig und per SVERWEIS gemacht und anschließend alles als Wertekopie überschrieben. Aber das muss doch auch anders gehen... Das sind 4 mal rund 700 Zeilen und auch wenn die Tätigkeit nur quartalsweise anfällt, wäre eine schnellere Lösung hilfreich...
Vielleicht gibt es auch eine ganz andere Lösung ohne den Umweg des Transponierens.
Letztendlich soll aus der 700 Zeilen-Matrix ein bestimmter Wert entnommen werden abhängig von der NL-Nr und vom Produkt. Das Problem ist halt, dass der Wert in 3 verschiedenen Spalten stehen kann.
Vielen Dank vorab für eure Unterstützung und Anregungen.
Gruß
Axel

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Werte transponieren oder direkt übertragen
07.03.2018 06:41:21
fcs
Hallo Axel,
ich würde für weitere Auswertungen nur die drei Vol-Spalten zu einer Spalte zusammenfassen und die Auswertungen per Pivot-Tabllenbericht machen.
Gruß
Franz
Sub Auswertung_vorbereiten()
Dim wksData As Worksheet
Dim wksNeu As Worksheet
Dim wksAusw As Worksheet
Dim Zeile As Long, Zelle As Range
If MsgBox("Auswertung mit Daten es aktiven Blatts erstellen?", _
vbOKCancel + vbQuestion, "Daten Auswerten") = vbCancel Then Exit Sub
Set wksData = ActiveSheet
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set wksNeu = ActiveWorkbook.Worksheets.Add(after:=wksData)
wksData.Range("A:D").Copy wksNeu.Cells(1, 1)
wksData.Range("H:K").Copy wksNeu.Cells(1, 5)
With wksNeu
.Name = "DatenNeu"
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
For Each Zelle In .Range(.Cells(2, 6), .Cells(Zeile, 8)).Cells
If Trim(Zelle.Text) = "" Then Zelle.ClearContents
Next
.Range(.Cells(2, 6), .Cells(Zeile, 8)).SpecialCells(xlCellTypeBlanks).Delete Shift:= _
xlToLeft
.Range(.Cells(1, 7), .Cells(1, 8)).Delete
.Cells(1, 6) = "Vol"
Set wksAusw = ActiveWorkbook.Worksheets.Add(after:=wksNeu)
wksAusw.Name = "Auswertung"
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
.Range(.Cells(1, 1), .Cells(Zeile, 6))) _
.CreatePivotTable TableDestination:=wksAusw.Cells(4, 1), TableName:="PivotTable1"
End With
With wksAusw.PivotTables(1)
With .PivotFields("NL-Nr.")
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("Produkt")
.Orientation = xlRowField
.Position = 1
End With
.AddDataField .PivotFields("Vol"), "Volumen", xlSum
.RowAxisLayout xlTabularRow
ActiveWorkbook.ShowPivotTableFieldList = False
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Anzeige
AW: VBA Werte transponieren oder direkt übertragen
07.03.2018 07:17:36
Axel
Guten Morgen Franz,
vielen Dank für Deine Mühe. Hammer!
Das Makro läuft in den Debugg bei "With .PivotFields("Produkt")"
Ich habe auch gesehen, dass nicht die richtigen Spalten behalten werden. Außerdem werden die Zahlen aus Spalte A transponiert (auch, wenn es danach nicht weitergeht). Ich versuche heute mal zwischendurch, den Code zu verstehen und ggf abzuändern und melde mich wieder. Heute bin ich allerdings fast den ganzen Tag in Terminen, also werde ich mich wahrscheinlich erst morgen wieder melden.
Danke nochmals und Gruß
Axel
AW: VBA Werte transponieren oder direkt übertragen
07.03.2018 08:04:05
Axel
Hi Franz,
ich bin mal schnell über das Makro geflogen und hab es wie folgt abgeändert:
Sub Auswertung_vorbereiten()
Dim wksData As Worksheet
Dim wksNeu As Worksheet
Dim wksAusw As Worksheet
Dim Zeile As Long, Zelle As Range
If MsgBox("Auswertung mit Daten des aktiven Blatts erstellen?", _
vbOKCancel + vbQuestion, "Daten Auswerten") = vbCancel Then Exit Sub
Set wksData = ActiveSheet
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set wksNeu = ActiveWorkbook.Worksheets.Add(after:=wksData)
wksData.Range("A:B").Copy wksNeu.Cells(1, 1)
wksData.Range("E:I").Copy wksNeu.Cells(1, 3)
With wksNeu
.Name = "DatenNeu"
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
Set wksAusw = ActiveWorkbook.Worksheets.Add(after:=wksNeu)
wksAusw.Name = "Auswertung"
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
.Range(.Cells(1, 1), .Cells(Zeile, 6))) _
.CreatePivotTable TableDestination:=wksAusw.Cells(4, 1), TableName:="PivotTable1"
End With
With wksAusw.PivotTables(1)
With .PivotFields("Name")
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("NL-Nr.")
.Orientation = xlRowField
.Position = 1
End With
.AddDataField .PivotFields("Ist YTD Ertr."), "Volumen", xlSum
.RowAxisLayout xlTabularRow
ActiveWorkbook.ShowPivotTableFieldList = False
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Der Ansatz ist gut.
Die Herausforderung besteht noch darin, dass die Volumina bestimmter Produkte in unterschiedlichen Spalten stehen, das wird hier noch nicht berücksichtigt. Es wird nur eine Volumensspalte in die Pivottabelle geladen. Das passt bei den meisten Produkten nicht, so dass dort 0 steht. Es wäre auch nicht zielführend, weitere Felder hinzuzufügen, dann wird die Tabelle auf andere Weise unübersichtlich.
Man müsste soetwas formulieren wie: Prüfe in jeder Zeile, ob in den drei Volumensspalten ein Wert steht und dann nimm diesen Wert.
Danke aber vielmals.
Axel
Anzeige
AW: VBA Werte transponieren oder direkt übertragen
07.03.2018 12:08:16
fcs
Hallo Axel,
das Verschieben der Inhalte aus Vol2 und Vol3 nach Vol1 hatte ich eigentlich schon drin.
Die Zeilen hast du baer bei deiner Überarbeiten gelöscht/nicht angepasst.
Nachfolgend 2 Varianten wie man es machen könnte.
Die nummern der Spalten musst du ggf. nochmals anpassen, das jetzt scheinbar Verschiebungen im Vegleich zu deiner Beispieldatei gegeben hat.
Gruß
Franz
'###    Leere Zellen löschen und Inhalte nach links verschieben   ####
With wksNeu
.Name = "DatenNeu"
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
'ab hier neu
'Leerstrings aus Zellen in Spalten "Vol1", "Vol2" und "Vol3" beseitigen
For Each Zelle In .Range(.Cells(2, 5), .Cells(Zeile, 7)).Cells
If Trim(Zelle.Text) = "" Then Zelle.ClearContents
Next
'Alle leeren Zellen in Spalten "Vol1", "Vol2" und "Vol3" löschen _
und Inhalte nach links verschieben
.Range(.Cells(2, 5), .Cells(Zeile, 7)).SpecialCells(xlCellTypeBlanks) _
.Delete Shift:=xlToLeft
'Spaltentitel "Vol2" und "Vol3" löschen
.Range(.Cells(1, 6), .Cells(1, 7)).Delete
'"Vol1" ändern in "Vol"
.Cells(1, 5) = "Vol"
'neues Blatt anlegen für Auswertung per Pivot-Bericht
'bis hier neu
Set wksAusw = ActiveWorkbook.Worksheets.Add(after:=wksNeu)
'###    oder Inhalte der einzelnen Zellen prüfen   ####
With wksNeu
.Name = "DatenNeu"
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
'ab hier neu
Dim Zei As Long, Spa As Long
'Zellinhalte in Spalten "Vol2" und "Vol3" prüfen und ggf. in Spalte "Vol1" eintragen
For Zei = 2 To Zeile
For Spa = 6 To 7
If Trim(.Cells(Zei, Spa).Text)  "" _
And .Cells(Zei, Spa).Value > 0 Then
.Cells(Zei, 5).Value = .Cells(Zei, Spa).Value
Exit For
End If
Next
'"Vol2" und "Vol3" löschen und Inhalte nach links verschieben
.Range(.Cells(1, 6), .Cells(1, 7)).EntireColumn.Delete Shift:=xlToLeft
'"Vol1" ändern in "Vol"
.Cells(1, 5) = "Vol"
'neues Blatt anlegen für Auswertung per Pivot-Bericht
'bis hier neu
Set wksAusw = ActiveWorkbook.Worksheets.Add(after:=wksNeu)

Anzeige
AW: VBA Werte transponieren oder direkt übertragen
07.03.2018 12:47:04
Axel
Hi Franz,
vielen Dank. Ich komme wahrscheinlich erst am Freitag morgen dazu, mir das genauer anzuschauen. Ich melde mich aber auf jeden Fall dazu.
Danke für Deine Unterstützung.
Axel
AW: VBA Werte transponieren oder direkt übertragen
09.03.2018 07:36:17
Axel
Hallo Franz,
Ich hab das Makro jetzt so da stehen:
Sub Auswertung_vorbereiten()
Dim wksData As Worksheet
Dim wksNeu As Worksheet
Dim wksAusw As Worksheet
Dim Zeile As Long, Zelle As Range
If MsgBox("Auswertung mit Daten es aktiven Blatts erstellen?", _
vbOKCancel + vbQuestion, "Daten Auswerten") = vbCancel Then Exit Sub
Set wksData = ActiveSheet
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set wksNeu = ActiveWorkbook.Worksheets.Add(after:=wksData)
wksData.Range("A:B").Copy wksNeu.Cells(1, 1)
wksData.Range("E:I").Copy wksNeu.Cells(1, 3)
With wksNeu
.Name = "DatenNeu"
'Leerstrings aus Zellen in Spalten "Vol1", "Vol2" und "Vol3" beseitigen
For Each Zelle In .Range(.Cells(2, 5), .Cells(Zeile, 7)).Cells
If Trim(Zelle.Text) = "" Then Zelle.ClearContents
Next
'Alle leeren Zellen in Spalten "Vol1", "Vol2" und "Vol3" löschen _
und Inhalte nach links verschieben
.Range(.Cells(2, 5), .Cells(Zeile, 7)).SpecialCells(xlCellTypeBlanks) _
.Delete Shift:=xlToLeft
'Spaltentitel "Vol2" und "Vol3" löschen
.Range(.Cells(1, 6), .Cells(1, 7)).Delete
'"Vol1" ändern in "Vol"
.Cells(1, 5) = "Vol"
'neues Blatt anlegen für Auswertung per Pivot-Bericht
Set wksAusw = ActiveWorkbook.Worksheets.Add(after:=wksNeu)
wksAusw.Name = "Auswertung"
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
.Range(.Cells(1, 1), .Cells(Zeile, 6))) _
.CreatePivotTable TableDestination:=wksAusw.Cells(4, 1), TableName:="PivotTable1"
End With
With wksAusw.PivotTables(1)
With .PivotFields("NL-Nr.")
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("Produkt")
.Orientation = xlRowField
.Position = 1
End With
.AddDataField .PivotFields("Vol"), "Volumen", xlSum
.RowAxisLayout xlTabularRow
ActiveWorkbook.ShowPivotTableFieldList = False
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

An der Stelle
'Leerstrings aus Zellen in Spalten "Vol1", "Vol2" und "Vol3" beseitigen
For Each Zelle In .Range(.Cells(2, 5), .Cells(Zeile, 7)).Cells
läuft's in den Debugg. Liegt wahrscheinlich daran, dass ich den Part:
wksData.Range("A:B").Copy wksNeu.Cells(1, 1)
wksData.Range("E:I").Copy wksNeu.Cells(1, 3)
abweichend habe. Bis dahin werden alle Spalten korrekt übertragen. Jetzt müsste der Part kommen, wo alle befüllten Zellen untereinander geschrieben werden, oder?
Danke und Gruß
Axel
Anzeige
AW: VBA Werte transponieren oder direkt übertragen
10.03.2018 02:32:30
fcs
Hallo Axel,
du hast eine wichtige Code-Zeile nicht übernommen oder versehentlich gelöscht.
            Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row

Dadurch ist Zeile = 0 und das Makro läuft in den Fehler.
Die Code-Zeile musst du hoer einfügen:
        .Name = "DatenNeu"
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
'Leerstrings aus Zellen in Spalten "Vol1", "Vol2" und "Vol3" beseitigen
For Each Zelle In .Range(.Cells(2, 5), .Cells(Zeile, 7)).Cells
Gruß
Franz
AW: VBA Werte transponieren oder direkt übertragen
12.03.2018 08:58:51
Axel
Guten Morgen Franz,
ich hab die Zeile eingefügt. Nun läuft das Makro an dieser Stelle in den Debug:
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
.Range(.Cells(1, 1), .Cells(Zeile, 6))) _
.CreatePivotTable TableDestination:=wksAusw.Cells(4, 1), TableName:="PivotTable1"
Fehlermeldung: "Dieser Befehl setzt mindestens zwei Zeilen voraus.... "
Sagt Dir das was?
Gruß
Axel
Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige