Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1428to1432
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 2 Tabellen zusammenführen und aktualisieren

VBA 2 Tabellen zusammenführen und aktualisieren
30.05.2015 14:00:17
Emre
Hallo,
ich bin neu hier und weiß ehrlich gesagt auch nicht ob ich in den richtigen Bereich schreibe.
Auf jeden Fall habe ich schon sehr viel im Netz gesucht, bin auch ein bisschen fündig geworden, aber so richtig weit bin ich nicht gekommen.
Es geht um folgendes, ich bin Werkstudent und habe die Aufgabe von meinem Betreuer einen Ablauf per VBA zu automatisieren. Es befinden sich 2 Listen. Die eine größere knapp 2000 Zeilen soll alle paar Monate durch eine kleinere Liste (knapp 300 Zeilen) aktualisiert werden. In der größeren Liste müssen auch manchmal Leute entfernt werden z.B. die Personen, die nicht mehr beim Unternehmen tätig sind. Oder wenn jemand mal die Abteilung wechselt, soll sich die Bezeichnung der Abteilung dann auch automatisch ändern. Die Listen werden aus Outlook gezogen und dann eben in Excel verarbeitet.
Von mir verlangt wird, dass ich den oben geschilderten Ablauf automatisiere, also das die große Liste von Outlook gezogen wird, dann mit der kleinen Liste (auch von Outlook) zusammen in Excel zusammengeführt wird. Dazu noch, dass die Personen die in der kleinen Liste sich befinden aber nicht in der großen Liste sind, ein X bekommen als Kennzeichnung.
Die letzte Woche habe ich das manuell gemacht und das war echt schlimm, daher die Automation. Der Aufbau der Listen ist gleich.
Hoffe, habe mein Problem schildern können. Wäre für eine Hilfe sehr dankbar.
MfG

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA 2 Tabellen zusammenführen und aktualisieren
30.05.2015 14:05:19
Emre
Noch etwas bevor ich es vergesse. Den folgenden Code habe ich im Internet gefunden und ein wenig erweitert. Er macht die Zusammenführung eigentlich ganz gut nur an manchen Stellen, ich vermute wenn eine es leere Zellen gibt, kommt er durcheinander und übernimmt bei der Zusammenführung nicht alles.
Es war eigentlich nur die erste Spalte die zusammengeführt wurde, habe die anderen Schleifen dann selber hinzugefügt und eben das Problem bekommen.
Public Sub Zusammenfuehren()
Dim aTabellen  As Variant   ' die Namen der zusammenzuführenden Tabellenblätter
Dim iBlatt     As Integer   ' der For/Next Index zum Array
Dim lZeile_Q   As Long      ' For/Next Schleifen-Index Zeilen Quell-Tabelle
Dim lZeile_Z   As Long      ' Ausgabe-Zeilen der Ziel-Tabelle
Dim WkSh_Z     As Worksheet ' die Ziel-Tabelle
Application.ScreenUpdating = False
'      im nachfolgenden Array können beliebig viele Tabellenblätter, deren
'      Inhalt zusammengeführt werden soll aufgezählt werden
aTabellen = Array("Tabelle1", "Tabelle2")
Set WkSh_Z = Worksheets("Tabelle3") ' das Ziel-Tabellenblatt - Namen ggf. anpassen !!!
For iBlatt = 0 To UBound(aTabellen)
With Worksheets(aTabellen(iBlatt))
For lZeile_Q = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If Application.WorksheetFunction.CountIf(WkSh_Z.Columns(1), _
.Range("A" & lZeile_Q).Value) = 0 Then
lZeile_Z = lZeile_Z + 1
WkSh_Z.Range("A" & lZeile_Z).Value = .Range("A" & lZeile_Q).Value
End If
If Application.WorksheetFunction.CountIf(WkSh_Z.Columns(2), _
.Range("B" & lZeile_Q).Value) = 0 Then
lZeile_Z = lZeile_Z + 0
WkSh_Z.Range("B" & lZeile_Z).Value = .Range("B" & lZeile_Q).Value
End If
If Application.WorksheetFunction.CountIf(WkSh_Z.Columns(3), _
.Range("C" & lZeile_Q).Value) = 0 Then
lZeile_Z = lZeile_Z + 0
WkSh_Z.Range("C" & lZeile_Z).Value = .Range("C" & lZeile_Q).Value
End If
If Application.WorksheetFunction.CountIf(WkSh_Z.Columns(4), _
.Range("D" & lZeile_Q).Value) = 0 Then
lZeile_Z = lZeile_Z + 0
WkSh_Z.Range("D" & lZeile_Z).Value = .Range("D" & lZeile_Q).Value
End If
If Application.WorksheetFunction.CountIf(WkSh_Z.Columns(5), _
.Range("E" & lZeile_Q).Value) = 0 Then
lZeile_Z = lZeile_Z + 0
WkSh_Z.Range("E" & lZeile_Z).Value = .Range("E" & lZeile_Q).Value
End If
If Application.WorksheetFunction.CountIf(WkSh_Z.Columns(6), _
.Range("F" & lZeile_Q).Value) = 0 Then
lZeile_Z = lZeile_Z + 0
WkSh_Z.Range("F" & lZeile_Z).Value = .Range("F" & lZeile_Q).Value
End If
If Application.WorksheetFunction.CountIf(WkSh_Z.Columns(7), _
.Range("G" & lZeile_Q).Value) = 0 Then
lZeile_Z = lZeile_Z + 0
WkSh_Z.Range("G" & lZeile_Z).Value = .Range("G" & lZeile_Q).Value
End If
Next lZeile_Q
End With
Next iBlatt
Application.ScreenUpdating = True
End Sub

Anzeige

315 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige