Clever-Excel-Forum

Hallo zusammen,

ich habe eine recht komplexe Anforderung die ich wahrscheinlich in professionelle Hände in Form einer Auftragsprogrammierung legen muss. Habe recht stümperhaft das Ganze mal über den Makrorekorder versucht.. Falls es doch weniger komplex ist als ich denke freue ich mich über jegliche Hilfestellungen =)

Ich habe zwei Dateien zwischen denen in per VBA einen sVerweis machen muss (und das einmal pro Monat). ich würde gerne die erste Datei (Name der Datei ist über die Monate nicht gleichbleibend, ich nenne Sie mal Datei(x1)) mittels eines Dialoges auswählen. In dieser Datei müsste ich nach der Spalte S, 5 neue Spalten einfügen, den Reiter "Klassifizierung" aus der Datei(x2) in die Datei(x1) kopieren. Die Spaltenüberschriften der 5 neuen Spalten ergeben sich aus dem kopierten Reiter "Klassifizierung" aus dem Bereich T6:X6. Zudem müssten nach der Spalte AA in der Datei(x1) zwei neue Spalten eingefügt werden und die mit "Teilbereich A" und "Teilbereich B" benannt werden (Bezeichnungen stehen aber auch in Datei(x2) im Bereich AB6:AC6.

Jetzt kommt der schwierige Teil:

Der sVerweis der die Spalteninhalte aus Datei(x2) ab T7:X7 in die Datei(x1) übergeben soll muss aus drei Suchkriterien bestehen, weil sonst keine Eindeutigkeit zwischen den beiden Dateien besteht=verketten(Datei(x1)B7_D7_E7). Die Inhalte aus Datei(x2) aus dem Bereich T7:Xn sollen per Sverweis/ index+Vergleich.. in den Bereich T7:Xn der Datei(x1) eingefügt werden.

Die in Spalte T in Datei(x1) übertragenen Daten sollen als Werte eingefügt werden. Zellen in dieser Spalte die nicht in Datei(x2) vorkamen müssten ein Dropdown hinterlegt bekommen. Aus dem Reiter Klassifizierung A3:A12.

Die Spalten U und V referenzieren anhand der Matrix des Reiters Klassifizierung auf den Output der Spalte T (sVerweis auf den Reiter Klassifizierung in der Datei(x1)).

Die Spalte W muss als Wert eingefügt werden. Die Spalte X auch als Wert allerdings als Datum formatiert.

Anbei mal beide Dateien stark vereinfacht. Evtl ist ja einer von euch wie ich bei der Sonne trotzdem am PC und hat Lust =)

Besten Dank & Grüße vorab
Leo

Hallo Leo,

mal stark vereinfacht geantwortet erst mal zwei recht simple Ansätze.

Ansatz 1) Um mit direkt SVERWEIS nach mehrspaltigen Kriterien zu suchen bräuchtest Du in der Quelle eine Hilfsspalte wo DU die Spalteneinträge zusammenfasst. Wäre das möglich? Dann bräuchte man nur beim Dateiwechsel mit Suchen & Ersetzen den Dateinamen zu ändern - auch per Makro anhand einer auszuwählenden Datei Smile

Ansatz 2) Mehrspaltige Suchkriterien bekommt man ohne Hilfsspalte mittels INDEX und Vergleich gezogen. Allerdings muss dafür die Quelle geöffnet sein. Dateiwechsel - siehe 1)

Ansatz 3) Per VBA die Quelle öffnen, die INDEX-Formeln im Ziel eintragen, Berechnen und die INDEX-Formeln mit den Ergebnissen ersetzen

Wegen dem Ersatz der Formeln durch Werte und dem flexibel einzusetzendem DropDown wäre dann wohl die Variante 3) vorzuziehen.

Was bedeutet denn einmal pro Monat? Kommen die im Vormonat gezogenen Daten weg und nur die aktuellen rein oder werden die Daten erweitert?

Hallo Schauan,

die Datei(x1) wird am Monatsanfang aus dem System erzeugt. Die Kollegen haben bis zu diesem Tag mit der vorherigen Systemversion -Datei(x2) gearbeitet und dort Ihre Kommentare eingearbeitet, die müssten dann auf den aktuellen Stand der Systemdatei übertragen werden. Es kann gut sein das Zeilen die in der Datei(x2) vorhanden waren, in der neuer (am Monatsanfang gezogenen Datei(x1) nicht mehr drinnen sind, dafür aber neue Zeilen hinzugekommen sind.

Variante 3 ist glaube die Variante die es zur Umsetzung bräuchte. In meinem Versuch das mit dem Makrorekorder umzusetzen hatte ich mir eine Hilfsspalte mit den Suchkriterien aufgebaut aber das Ergebnis war Kraut und Rüben (was mit Sicherheit an meinen Fähigkeiten und nicht an dem Lösungsansatz mittels einer Hilfsspalte per se gelegen hat Angel

)

Beste Grüße
Leo

Hallo zusammen,

ich habe es nochmal mit dem Makrorekorder und einer Hilfsspalte gelöst die danach wieder gelöscht wird.
Durch das ganze Select und Acivate braucht es leider doch recht lange diese, eigentlich simple Anforderung umzusetzen.

Uuund.. leider werden nur die ersten 3 Zellen in der Spalte T mit dem gewünschten Dropdown hinterlegt, sonst macht es das was es tun soll :17: :17:

Falls einer von euch das Ganze noch ein wenig schneller & stabiler umschreiben mag, ich würde mich sehr freuen =)

Liebe Grüße
Leo

Hallöchen,

ich schaue morgen Abend erst wieder rein …
Select und die folgende Aktion kann man meist kombinieren, z.B.

Range("A1").Select
Selection.Copy

wird dann

Range("A1").Copy

Hi zusammen,

nochmal überarbeitet und die (Reiter)- Bezeichnungen des Originals im Code.
ich hoffe das es einer von euch evtl doch noch robuster und schneller machen mag

Beste Grüße
leo

Hallöchen,

hier ist das Makro mal "wild" reduziert. Musst mal schauen, ob es noch läuft. Prinzipiell hast DU einige Sachen mehrfach drin, Select kann man vermeiden und zusammenfassen, wie ich schon schrieb, wobei da sicher noch einige zu viel drin sind, z.B. Range(Selection, Selection.End(xlDown)).Select, einiges Scrollen muss auch nicht sein, und wenn Deine Daten mal anders kommen könnte auch das Eine oder Andere nicht mehr laufen ... …

Code:
Sub Makro1()

'

    Application.Run "Test_V2.xlsm!Dialog"

    With Rows("1:3")

        .HorizontalAlignment = xlGeneral

        .VerticalAlignment = xlTop

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlLTR

        .MergeCells = False

        .UnMerge

    End With

    Columns("T:Y").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Columns("AB:AC").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Range("A7").FormulaR1C1 = "=CONCATENATE(RC[2],""_"",RC[4],""_"",RC[5])"

    Range("A7").AutoFill Destination:=Range("A7:A7425")

    Range("A7408").AutoFill Destination:=Range("A7408:A15000"), Type:=xlFillDefault

    Range("C7").Select

    Application.Run "Test_V2.xlsm!Dialog"

    Sheets("Klassifizierung").Select

    Sheets("Klassifizierung").Copy After:=Workbooks("Aktuell.xlsx").Sheets(1)

    Range("A1:E1").Copy

    Sheets("Rueckstandsliste_Intern").Select

    Range("U6").Paste

    Range("AC6").FormulaR1C1 = "Teilbereich A"

    Range("AD6").FormulaR1C1 = "Teilbereich B"

    Range("X6:Y6").Copy

    Range("AC6:AD6").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

        SkipBlanks:=False, Transpose:=False

    Application.CutCopyMode = False

    Windows("Feedback.xlsx").Activate

    Sheets("Rueckstandsliste_Intern").Select

    Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Range("A7").FormulaR1C1 = "=CONCATENATE(RC[2],""_"",RC[4],""_"",RC[5])"

    Range("A7").AutoFill Destination:=Range("A7:A7409")

    Range("A7:A7409").End(xlDown).AutoFill Destination:=Range("A7408:A15000"), Type:=xlFillDefault

    Range("B7").Select

    Windows("Aktuell.xlsx").Activate

    Range("U7").FormulaR1C1 = _

        "=VLOOKUP(RC[-20],[Feedback.xlsx]Reiter_Gesamt!R7C1:R1048576C25,21,FALSE)"

    Range("U7").AutoFill Destination:=Range("U7:U15000")

    Range("U7").Select

    Range(Selection, Selection.End(xlDown)).Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.Copy

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Range("U7").Select

    ActiveSheet.Range("$B$6:$AE$15180").AutoFilter Field:=20, Criteria1:="0"

    Range("U7").Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.ClearContents

    ActiveSheet.Range("$B$6:$AE$15180").AutoFilter Field:=20

    Range("U7:U15000").Select

    Range(Selection, Selection.End(xlDown)).Select

    Range(Selection, Selection.End(xlDown)).Select

    Range(Selection, Selection.End(xlDown)).Select

    Range(Selection, Selection.End(xlDown)).Select

    Range(Selection, Selection.End(xlDown)).Select

    Range(Selection, Selection.End(xlDown)).Select

    Application.CutCopyMode = False

    With Selection.Validation

        .Delete

        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

        xlBetween, Formula1:="=Klassifizierung!$A$3:$A$12"

        .IgnoreBlank = True

        .InCellDropdown = True

        .InputTitle = ""

        .ErrorTitle = ""

        .InputMessage = ""

        .ErrorMessage = ""

        .ShowInput = True

        .ShowError = True

    End With

    Selection.End(xlUp).Select

    Range("V7").FormulaR1C1 = _

        "=IFERROR(VLOOKUP(RC21,Klassifizierung!R3C1:R12C3,COLUMN(Klassifizierung!C[-20]),FALSE),"""")"

    Range("V7").AutoFill Destination:=Range("V7:W7"), Type:=xlFillDefault

    Range("V7:W7").AutoFill Destination:=Range("V7:W15180")

    Range("X7").FormulaR1C1 = _

        "=VLOOKUP(RC[-23],[Feedback.xlsx]Reiter_Gesamt!R7C1:R1048576C25,24,FALSE)"

    Range("X7").AutoFill Destination:=Range("X7:Y7"), Type:=xlFillDefault

    Range("Y7").FormulaR1C1 = _

        "=VLOOKUP(RC[-24],[Feedback.xlsx]Reiter_Gesamt!R7C1:R1048576C25,25,FALSE)"

    Range("X7:Y7").AutoFill Destination:=Range("X7:Y15180")

    Range("X7:Y7").Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.Copy

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    ActiveSheet.Range("$B$6:$AE$15180").AutoFilter Field:=23, Criteria1:="=0", _

        Operator:=xlOr, Criteria2:="=#NV"

    Range("X7").Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.ClearContents

    ActiveSheet.Range("$B$6:$AE$15180").AutoFilter Field:=23

    ActiveSheet.Range("$B$6:$AE$15180").AutoFilter Field:=24, Criteria1:="=0", _

        Operator:=xlOr, Criteria2:="=#NV"

    Range("Y7").Select

    Range(Selection, Selection.End(xlDown)).Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.ClearContents

    Range("Y6").Select

    ActiveSheet.Range("$B$6:$AE$15180").AutoFilter Field:=24

    Columns("Y:Y").Select

    Selection.NumberFormat = "m/d/yyyy"

    Columns("A:A").Select

    Selection.Delete Shift:=xlToLeft

    Windows("Feedback.xlsx").Activate

    Columns("A:A").Select

    Selection.Delete Shift:=xlToLeft

    Range("F14").Select

    ActiveWindow.Close

    Range("C7").Select

    ActiveWindow.FreezePanes = False

    ActiveWindow.FreezePanes = True

    Range("T22").Select

End Sub

Hallo Schauan,

ich habe mir deinen Rat zu Herzen genommen und alles soweit wie möglich eingestampft Blush

und es läuft immer noch =)
Würde den Stand jetzt erstmal so beibehalten, habe es mit neuen x1 Dateien versucht und es funktioniert (zwar nicht unbedingt schnell) gut.

Besten Dank für deine Hilfe, ich werde jetzt versuchen den Code immer weiter zu verfeinern =)

Liebe Grüße
Leo

Leonhard

schauan

Leonhard

Leonhard

schauan

Leonhard

schauan

Leonhard