Mehrere Datein mit VBA zusammen Führen. Quelldatein und Muster-Datein habe Unterschiedliche Struktur
31.01.2020 13:06:33
Telesphore
ich versuche mehrere Excel Datein (Quelldadein) in einem Muster-Dadein zusammenzuführen.
1) Quelldatein (xls) und Muster-Datein haben unterschiedliche Struktur
2) jeder Monat bekomme ich ein Quelldatei ( wichtig sind nur Spalten mit als Titel: Inventurnummer, Nr. und mit den Indizes Cg, cgk und %GR)
3) die Werte in diesen Spalten müssen mit Bedingungen im Muster-Datein Importiert werden.
4) Muster-datein hat 3 Tabelle mit den Name Cg, Cgk und %GR und in jeden Monat sollen die endsprechende Werte Importiert werden.
AUFGABE
1) Die Werte müssen über ein Makro mit Knopf Importiert werden
2) also in Muster-Datei auf jede Tabelle 12 Knöpfen, die die Monate Januar bis Dezember entsprechen.
3) Das Makro soll in Muster-Datei Stehen.
4) Das Makro soll die Datein in einem Speziellen ordner ablegen und mit Bedingungen ablesen.
MEINE MAKRO
ich habe hier ein Mkro gefunden und angepasst , das die Punkte 1 bis 4 löst
so sieht er aus für JANUAR z.b.
Public Sub Daten_Januar_zusammenfuehren()
'Code für ein allgemeines Modul
On Error GoTo errExit
Dim WBQ As Workbook
Dim WBZ As Workbook
Dim intSh As Integer
Dim varDateien As Variant
Dim lngAnzahl As Long
Dim lngLastQ As Long
Set WBZ = ActiveWorkbook
'Altdaten auf Zielblatt löschen
'ÄWBZ.Worksheets(1).Range("A2:IV65536").ClearContents
varDateien = _
Application.GetOpenFilename("Datei (*.xls),*.xls", False, "Bitte gewünschte Datei(en) markieren" _
, False, True)
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
For lngAnzahl = LBound(varDateien) To UBound(varDateien)
Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
For intSh = 1 To WBQ.Worksheets.Count
lngLastQ = WBQ.Worksheets(intSh).Range("A65536").End(xlUp).Row
WBQ.Worksheets(intSh).Range("AC7:AC67" & lngLastQ).Copy
WBZ.Worksheets(1).Range("E7:E100" & WBZ.Worksheets(1).Range("A65536").End(xlUp).Row +1). _
PasteSpecial xlPasteValues
Next
WBQ.Close
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64
Exit Sub
errExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
If Err.Number = 13 Then
MsgBox "Es wurde keine Datei ausgewählt"
Else
MsgBox "Es ist ein Fehler aufgetreten!" & vbCr _
& "Fehlernummer: " & Err.Number & vbCr _
& "Fehlerbeschreibung: " & Err.Description
End If
End Sub
1) Der Struktur der Quelldatein ist von Monat zu Monat Unterschiedlich
2) in einigen Monaten hat man weniegen Zeilen unb bei welchen mehrere
BEDINGUNGEN
also Das Makro soll:
a) Zellen im Quelldatein (Spalten INVENTURNUMMER und Nr.) mit Zellen Im Muster-Datein (Spalten INVENTURNUMMER und Nr) vergeichen.
a.1) wenn ein Wert in der Zelle der Spalte INVENTURNUMMER( Quelldatein) GLEICH ein Wert in der Zelle der Spalte INVENTURNUMMER (Muster-Dateien) ist dann:
NB: die zeilennummer in Quell und Muster-Datein können unterschiedlich sein.
a.1.1) Überprüfen AUCH ob den Wert in der Zelle der Spalte Nr (Quelldatein) gleich der Wert in der Spalte Nr.(Muster-Dateien) gleich ist.
- wenn JA Wert entsprechende Zelle ( Quelldatein) in Muster-Dateien in der Spalte Cg (Indiz)
Importieren
- wenn NEIN im Muster-Datein in der nächsten leeren Zelle werte in der Zelle der Spalte
INVENTURNUMMER, Nr, und Cg (Indiz) Importieren
a.2) Wenn der Wert in der Zelle der Spalte INVENTURNUMMER( Quelldatein) UNGLEICH der Wert in der
Zelle der Spalte INVENTURNUMMER (Muster-Dateien) ist
- dann genauso im nächsten leeren Zeile Importieren.
Bitte könnte jemand meine Makro mit den Bedingungen anpassen?
es wird reichen wenn es für nur eine Tabelle in meinem Muster-Datein (auch ein Monat Z.b Januar ) angepasst ist
als Beispiel habe ich auch zwei entwürf Datein hingefügt (einmal Muster-Datein und Quelldatein)
https://www.herber.de/bbs/user/134870.xlsx
https://www.herber.de/bbs/user/134871.xls