Datenzusammenführung

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub DatenZusammen() Dim rng As Range, iZeile As Integer, iSpalte As Integer, Zielzeile As Integer Set rng = Worksheets("Datenbasis").Range("A2").CurrentRegion Worksheets("Ziel").Cells(1, 1) = "Kunde" Worksheets("Ziel").Cells(1, 2) = "Emails" Zielzeile = 2 'Die einzelnen Eintragungen in die Zieltabelle kopieren For iZeile = 2 To rng.Rows.Count For iSpalte = 2 To 4 If rng.Cells(iZeile, iSpalte) "" Then Worksheets("Ziel").Cells(Zielzeile, 1) = rng.Cells(iZeile, 1) Worksheets("Ziel").Cells(Zielzeile, 2) = rng.Cells(iZeile, iSpalte) Zielzeile = Zielzeile + 1 End If Next iSpalte Next iZeile 'Duplikate entfernen Worksheets("Ziel").Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=Array(1, 2), Header:= _ xlYes End Sub

Hallo Nils,
PowerPivot und PowerQuery sind Kraftpakete, um viele Daten aus unterschiedlichsten Datenquellen in Excel einzulesen und zu behandeln:
- viele/alle Dateien in einem Verzeichnis
- Datenkorektur, wenn die Spaltzenamen nicht in der selben Reihenfolge vorliegen
- Ausertung/Vergleich von Zeiträumen unterschiedlicher Jahre/Quartale/Monate/KW/u.u.u
Aber schau mal hier:


https://www.video2brain.com/de/videotraining/excel-2013-power-query?autoplay=1
https://www.video2brain.com/de/videotraining/excel-2016-2013-pivot-berichte-mit-datenmodell-verbessern

Da gibt es neben der Übersicht auch 3-4 freie Videos zu anschauen.
Die integrierten Scriptsprachen (leider nicht Vba) vereinfachen wesentlich das Anpassen bereits erstellter Abfragen/Pivotberichte auf neue/geänderte Voraussetzungen.
Gruß von Luschi
aus klein-Paris

Hallo Nils,
probier mal:

Sub Verdichten()
Dim rng As Range
Dim rngBereich As Range
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet
'________________________________________ anpassen
Set wksQuelle = Worksheets("Datenbasis")
Set wksZiel = Worksheets("Ziel")
Dim i As Long
Dim lastRow As Long
lastRow = wksQuelle.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
With wksQuelle
.Range("A3:B" & lastRow).Copy wksZiel.Range("A2")
.Range("C3:C" & lastRow).Copy wksZiel.Range("B" & wksZiel.Cells(Rows.Count, "A").End(xlUp). _
Row + 1)
.Range("A3:A" & lastRow).Copy wksZiel.Range("A" & wksZiel.Cells(Rows.Count, "A").End(xlUp). _
Row + 1)
.Range("D3:D" & lastRow).Copy wksZiel.Range("B" & wksZiel.Cells(Rows.Count, "A").End(xlUp). _
Row + 1)
.Range("A3:A" & lastRow).Copy wksZiel.Range("A" & wksZiel.Cells(Rows.Count, "A").End(xlUp). _
Row + 1)
End With
With wksZiel
.Range("A2:B" & .Cells(Rows.Count, "A").End(xlUp).Row).Sort _
Key1:=.Range("A2"), Order1:=xlAscending, _
Header:=xlNo
.Range("B2:B" & .Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeBlanks). _
EntireRow.Delete
Set rngBereich = .Range("B2:B" & .Cells(Rows.Count, "A").End(xlUp).Row)
For Each rng In rngBereich
If Application.WorksheetFunction.CountIf(rngBereich, rng.Value) > 1 Then
rng.EntireRow.Delete
End If
Next
End With
Set wksQuelle = Nothing
Set wksZiel = Nothing
Set rng = Nothing
Set rngBereich = Nothing
End Sub

Gruß
Klaus

With wksQuelle lz = wksZiel.Cells(Rows.Count, "A").End(xlUp).Row + 1 .Range("A3:B" & lastRow).Copy wksZiel.Range("A2") .Range("C3:C" & lastRow).Copy wksZiel.Range("B" & lz) .Range("A3:A" & lastRow).Copy wksZiel.Range("A" & lz) .Range("D3:D" & lastRow).Copy wksZiel.Range("B" & lz) .Range("A3:A" & lastRow).Copy wksZiel.Range("A" & lz) End With

Beliebteste Forumthreads (12 Monate)

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread