|
Hallo,
ich werde Ihren Hinweis mal durchdenken. Erstmal besten Dank dafür. Es führen ja bekanntlich viele Wege nach Rom...
Mir geht es hauptsächlich das ganze soweit wie möglich automatisieren. Leider bin ich gern gelernter IT'ler oder Programmierer sondern Finanzwirt und habe mir mein jetzigen Kenntnisstand nach und nach selbst beigebracht - Naja, egal.
Hier mein aktueller Stand:
Sub Ruecklaufquote()
Dim wbQuelle1 As Workbook
Dim wbQuelle2 As Workbook
Datei = Application.GetOpenFilename("Excel, *.xls*")
If LCase(Datei) Like "fal*" Then Exit Sub
Set wbQuelle1 = Workbooks.Open(Datei, ReadOnly:=True)
wbQuelle1.Activate 'ausgewählte Monitoringauswahl öffnen
Columns("A:BA").Select 'Zeilen A-BA auswählen
Selection.Copy 'Auswahl kopieren
ThisWorkbook.Activate 'Vorlagendatei öffnen
Sheets(1).Select 'Reiter 2 aktivieren
Columns("A:A").Select 'Spalte A anwählen
ActiveSheet.Paste 'Auswahl einfügen
Application.CutCopyMode = False 'Auswahl aufheben
wbQuelle1.Close 'Monitoringauswahl schließen
ThisWorkbook.Activate
Sheets.Add After:=Sheets(Sheets.Count) 'neuen Reiter anlegen
Datei = Application.GetOpenFilename("Excel, *.xls*")
If LCase(Datei) Like "fal*" Then Exit Sub
Set wbQuelle2 = Workbooks.Open(Datei, ReadOnly:=True)
wbQuelle2.Activate 'ausgewählte Kopfliste öffnen
Columns("A:Z").Select 'Zeilen A-Z auswählen
Selection.Copy 'Auswahl kopieren
ThisWorkbook.Activate 'Monitoringauswertung öffnen
Sheets(2).Select 'Reiter 2 aktivieren
Columns("A:A").Select 'Spalte A anwählen
ActiveSheet.Paste 'Auswahl einfügen
Application.CutCopyMode = False 'Auswahl aufheben
wbQuelle2.Close 'Kopfliste schließen
'---=== Dublettenprüfung ===---
Sheets(1).Select
Range("AZ1").Select
ActiveCell.Formula = "=COUNTA(U2:U10000)" 'Zählen der Monitoringdaten in Spalten U
Range("AZ1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'Wert in AZ1 mittels Wert einfügen fixieren
Columns("A:AX").Select
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$AX$10000").RemoveDuplicates Columns:=Array(6, 7, 8, 20) _
, Header:=xlYes 'Dublettenprüfung in auf Basis Spalten 6,7,8,21
Range("AZ2").Select
ActiveCell.Formula = "=COUNTA(U2:U10000)" 'Zählen der Monitoringdaten in Spalten U nach Dublettenbereinigung
Range("AZ2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'Wert in AZ2 mittels Wert einfügen fixieren
Columns("A:AX").Select
Application.CutCopyMode = False
Sheets(2).Select
Range("G1").Select
ActiveCell.Formula = "=COUNTA(D2:D10000)" 'Zählen der Kopfdaten in Spalten D
Range("G1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'Wert in G1 mittels Wert einfügen fixieren
Columns("A:D").Select
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$D$10000").RemoveDuplicates Columns:=Array(1, 2, 3, 4) _
, Header:=xlYes 'Dublettenprüfung in auf Basis Spalten 1,2,3,4
Range("G2").Select
ActiveCell.Formula = "=COUNTA(D2:D10000)" 'Zählen der Kopfdaten in Spalten D nach Dublettenbereinigung
Range("G2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'Wert in G2 mittels Wert einfügen fixieren
Columns("A:D").Select
Application.CutCopyMode = False
'---===Tabellenabgleich===---
'???
'SVERWEIS???
End Sub |