Spalten verschiedener Tabellen Vergleichen und Werte aktualisieren bzw. neu anlegen

  • Excel

Es gibt 7 Antworten in diesem Thema. Der letzte Beitrag () ist von sawes13.

    Spalten verschiedener Tabellen Vergleichen und Werte aktualisieren bzw. neu anlegen

    Sehr geehrte Forenmitglieder,

    ich stehe vor folgendem Problem und erhoffe Hilfe:

    Ich möchte ein Makro auf einen Command Button erstellen, der mir beim Klicken zunächst den Inhalt einer Zelle in Tabelle1 mit einer ganzen Zeile einer anderen Tabelle2 abgleicht um zu sehen ob es diesen Namen schon gibt.

    Wenn ja: Soll die ganze Spalte mit Einträgen von Zeile 2 bis 52 der Tabelle 1 (Input Mask) in die jeweilige Spalte in Tabelle 2 (Projects) geschrieben werden, in der dieser Name bereits steht.

    Wenn nein: Soll der gesamte Eintrag aus Tabelle 1 neben dem letzten Eintrag in Tabelle 2 in einer neuen Spalte eingefügt werden.

    Eventuelles Problem: Die zu durchsuchenden Spalten in Tabelle2 fangen erst ab Spalte 12 (L) an.

    Leider bin ich völliger Vba-Neuling und komme damit nicht zurecht.

    Vielen Dank im voraus und freundliche Grüße
    Sascha

    VB.NET-Quellcode

    1. Private Sub Export_Click()
    2. Dim test As Boolean
    3. Dim i As Double
    4. Dim lcolumn As Long
    5. Dim e As Range
    6. ' cells(z,s)
    7. With Sheets("Projects")
    8. lcolumn = UsedRange.SpecialCells(xlCellTypeLastCell).Column
    9. End With
    11. For i = 12 To Sheets("Projects").Cells(6, lcolumn + 1)
    12. If Worksheets("Projects").Cells(6, i).Value = Worksheets("Input Mask").Cells(3, 2).Value Then
    13. Worksheets("Projects").Range(Sheets("Projects").Cells(2, i), Sheets("Input Mask").Cells(52, i)) = Worksheets("Input Mask").Range(Sheets("Input Mask").Cells(2, 5), Sheets("Input Mask").Cells(52, 5))
    14. test = True
    15. Else
    16. test = False
    17. End If
    18. Next
    19. If test = False Then
    20. Worksheets("Projects").Range(Sheets("Projects").Cells(2, lcolumn + 1), Sheets("Projects").Cells(52, lcolumn + 1)) = Worksheets("Input Mask").Range(Sheets("Input Mask").Cells(2, 5), Sheets("Input Mask").Cells(52, 5))
    21. Else
    22. test = False
    23. End If
    24. End Sub


    *auf korrektes Codetag ausgebessert* ~NoFear23m

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Nofear23m“ ()

    sawes13 schrieb:

    Worksheets("Projects").Range(Sheets("Projects").Cells(2, i), Sheets("Input Mask").Cells(52, i)) = Worksheets("Input Mask").Range(Sheets("Input Mask").Cells(2, 5), Sheets("Input Mask").Cells(52, 5))
    ???
    Meinst du vielleicht

    Visual Basic-Quellcode

    1. Sheets("Projects").Cells(2, i).Value = Sheets("Input Mask").Cells(52, i).Value
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Erstmal danke für deine schnelle Antwort.

    Das habe ich so geschrieben, weil sonst nicht erkannt wird, dass sich die Zellen der Tabelle Projects in einer anderen Tabelle befinden als die, wo der command button hinterlegt ist.

    Ebenso habe ich Range verwendet, da er den gesamten Bereich der Spalte (Zeile 2-52) in dem der Name aus der if bedingung mit Zelle (3,2) übereinstimmt mit den werten aus dem Bereich der Tabelle Input Mask ersetzten soll.

    VG
    Sascha

    Natürlich:

    https://ibb.co/JRX27B8 Bild 1

    ibb.co/w6vHsjw Bild 2

    Es soll abgeglichen werden, ob der unter der Spalte (Bild 1) "Adjust" eingetragene Projektname bereits in Tabelle 2 Zeile 6 in einer Spalte exisitiert.

    Wenn ja, soll die Spalte aus Input Mask in diese Spalte in Projetcs eingefügt werden und diese überschreiben.

    Wenn möglich soll dann noch via Message Box/Userform Gefragt werden ob man sich sicher ist, dass man die Daten exportieren möchte, da der Datensatz unter dem Projektnamen bereits vorhanden ist.

    Sollte der Projektname nicht in einer der Spalten aus Zeile 6 Tabelle Projects vorhanden sein, dann soll der Eintrag neu angelegt werden in rechts neben der letzten beschriebenen Spalte in der bereits ein Projekt steht.

    Ich hoffe du kannst mir helfen..

    Vielen Dank im Voraus und freundliche Grüße

    Sascha

    @sawes13 bitte in Zukunft die interne Forumsfunktion für Dateianhänge nutzen. (Erweiterte Antwort) ~NoFear23m

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Nofear23m“ ()

    Eigentlich dachte ich ja, du hängst ein Excel an.

    sawes13 schrieb:

    Es soll abgeglichen werden, ob der unter der Spalte (Bild 1) "Adjust" eingetragene Projektname bereits in Tabelle 2 Zeile 6 in einer Spalte exisitiert.
    In der Spalte stehen 20 Projektnamen.
    Willst du die alle überprüfen?
    Oder nur den Namen aus Zelle B3?
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Nein es geht nur um die rot markierte Zelle in E6, dort steht immer der Projektname und die soll abgeglichen werden.


    Edit 01.08.2019 9:50 Uhr:

    Ich würde mein nun funktionierendes Makro so erweitern, dass er die Daten nur überschreibt (erste if-Bedingung) wenn man in einer Userform auch bestätigen drückt und abbricht, wenn man auf abbrechen klickt

    Habt ihr eine Idee wie ich das implementieren kann?

    XML-Quellcode

    1. Private Sub Export_Click()
    2. Dim w As Double
    3. Dim te As Boolean
    4. Dim var As Boolean
    5. Dim lcolumn As Long
    6. w = 12
    7. 'cells(z,s)
    8. lcolumn = Sheets("Projects").UsedRange.Columns.Count
    9. For w = 12 To 100
    10. If Sheets("Projects").Cells(6, w).Value = Worksheets("Input Mask").Cells(6, 5).Value Then
    11. Sheets("Input Mask").Range(Sheets("Input Mask").Cells(2, 5), Sheets("Input Mask").Cells(52, 5)).Copy
    12. Sheets("Projects").Paste Destination:=Sheets("Projects").Range(Sheets("Projects").Cells(2, w), Sheets("Projects").Cells(52, w))
    13. var = True
    14. Else
    15. te = True
    16. End If
    18. If var = False And w = 100 Then
    19. Sheets("Input Mask").Range(Sheets("Input Mask").Cells(2, 5), Sheets("Input Mask").Cells(52, 5)).Copy
    20. Sheets("Projects").Paste Destination:=Sheets("Projects").Range(Sheets("Projects").Cells(2, lcolumn + 1), Sheets("Projects").Cells(52, lcolumn + 1))
    21. Else
    22. te = False
    23. End If
    24. Next
    25. var = False
    26. End Sub

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „sawes13“ ()

Facebook
Telefonspende