VBA Werte aus mehreren Tabellenblättern übernehmen

  • Excel

Es gibt 8 Antworten in diesem Thema. Der letzte Beitrag () ist von lochhocker.

    VBA Werte aus mehreren Tabellenblättern übernehmen

    Ahoi,

    ich erstelle mir derzeit eine Arbeitsmappe:
    In meinem letzten Tabellenblatt befindet sich eine Liste von Herstellern und Produkten. Jetzt mache ich es so, dass ich mit Hilfe einer Userform ein neues Produkt in dieses letzte Blatt hinzufügen kann. Dabei wird mir außerdem ein neues Tabellenblatt erstellt mit dem Namen des Produktes.

    Jedes Produkt wird in vier Typen unterteilt. Das spielt zwar in in dieser Liste keine Rolle, aber dafür in meinem Tabellenblatt 1. Hier stehen nämlich nochmals alle Produkte, hier jedoch jeweils in Nr. 1, 2, 3 und 4 unterteilt.

    In Spalte A stehen dabei die Produkte, in B steht einfach untereinander 1,2,3,4.

    Nun will ich erreichen, dass ich, wenn ich ein neues Tabellenblatt in meiner Liste erstellt habe, auch ein neuer Eintrag in meinem ersten Blatt gemacht wird, nämlich mit dem gleichen Namen, den auch das neue Tabellenblatt trägt.

    Dabei bin ich wie folgt vorgegangen:

    Visual Basic-Quellcode

    1. Private Sub auswahl_aktualisieren()
    2. Dim rngCol As Range, objF As Object, FirstFreeRow As Long, i As Long
    3. Dim isheet As Long
    5. With Worksheets("auswahl")
    6. Set rngCol = .Columns(2) 'Spalte B
    7. Set objF = rngCol.Find("*", SearchDirection:=xlPrevious, lookat:=xlPart)
    8. If Not objF Is Nothing Then
    9. FirstFreeRow = objF.Row + 1
    10. i = FirstFreeRow
    11. For isheet = 4 To Sheets.Count - 1
    12. If WorksheetFunction.CountIf(Range("A:A"), Sheets(isheet).Name) = 1 Then
    13. Cells(i, 1) = ""
    14. Else
    15. If WorksheetFunction.CountIf(Range("A:A"), Sheets(isheet).Name) = 0 Then
    16. Cells(i, 1).Value = Sheets(isheet).Name
    17. Cells(i, 2) = "1"
    18. Cells(i + 1, 2) = "2"
    19. Cells(i + 2, 2) = "3"
    20. Cells(i + 3, 2) = "4"
    21. End If
    22. End If
    23. Next
    24. End If
    25. End With
    27. End Sub


    Das ganze funktioniert prinzipiell schon mal.
    Nur bekomme ich es nicht hin, dass es vernünftig automatisch ausgeführt wird.
    Wenn ich es mit

    Visual Basic-Quellcode

    1. Private Sub Workbook_NewSheet(ByVal Sh As Object)
    2. Call auswahl_aktualisieren
    3. End Sub

    mache, dann benennt er das ganze in Blatt 1 nur als "TabelleX", da die Änderungen am Namen des Blattes natürlich erst unmittelbar nach dem Erstellen passiert.
    Bei worksheet_change(ByVal Target As Range) erstellt er mir immer irgendwelche Daten in meiner Liste.
    Vielleicht habt ihr ja noch eine gute Idee, wie ich es einfacher und besser machen kann.

    Doof ist ja auch, dass immer nur das als letztes erstellte Tabellenblatt übernommen wird.
    Wäre also schön, wenn man das irgendwie umgehen könnte.


    So viel zum ersten.

    Außerdem benötige ich eine Möglichkeit, aus meinen Tabellenblättern mit den Produkten gewisse Bereiche zu übernehmen. Diese Bereiche sind jedoch immer die gleichen, also z.B. A6:B10, A12:B16, A16:B20 und A22:B26. Nur eben von jedem Tabellenblatt.

    Am einfachsten wäre es wohl, wenn diese Werte einfach untereinander in meiner Auswahl (Tabellenblatt1) landen und ich sie dort mit Excel weiter verarbeite.
    Vielleicht hat da ja jemand eine Idee, wie ich diese ganzen Werte bekomme. Dazu habe ich bisher

    Visual Basic-Quellcode

    1. Private Sub Werte_einfuegen()
    2. Dim rngCol As Range, objF As Object, FirstFreeRow As Long, i As Long
    3. Dim isheet As Long
    5. With Worksheets("auswahl")
    6. Set rngCol = .Columns(1) 'Spalte A
    7. Set objF = rngCol.Find("*", SearchDirection:=xlPrevious, lookat:=xlPart)
    8. If Not objF Is Nothing Then
    9. FirstFreeRow = objF.Row + 1
    10. i = FirstFreeRow
    11. For isheet = 4 To Sheets.Count - 1
    12. If WorksheetFunction.CountIf(Range("A:A"), Sheets(isheet).Name) = 1 Then
    13. Worksheets("Reifenauswahl").Cells(i, 15).Value = Sheets(isheet).Range("A19:B23").Value
    14. End If
    15. Next
    16. End If
    17. End With
    19. End Sub


    Das funktioniert leider so nicht. Außerdem müssen mehrere Ranges pro Tabellenblat übernommen werde.

    Eine Datei ist auch angehängt.

    Vielen Dank im Voraus!

    VB-Tags eingefügt. Datei entfernt: Office-Dateien sind ausführbar, da sie Makros enthalten können. Diese Makros können Schadcode enthalten. ~Thunderbolt

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

    petaod schrieb:

    Geh im Worksheet_Activate deiner Übersichstliste alle Sheets durch und überprüfe, ob sie schon enthalten sind.
    Wenn nicht trage sie ein


    Jetzt muss ich mal blöd fragen: Was meinst du mit Übersichtsliste? Die Projekt-Übersicht?
    Und was nützt mir da das Worksheet_Activate? Das löst doch nur aus, wenn ein anderes Sheet aktiviert wird oder?
    Wenn ich mit meiner Userform einen neuen Eintrag in meine Liste mache, erstellt mir Excel ja ein neues Blatt, aber öffnet dieses nicht, sondern bleibt in der Liste. Mein Problem ist ja jetzt, dass ich, auch wenn ich ein Worksheet_change(Byval Target as Range) in meiner Arbeitsmappe einfüge und dann mein Makro aufrufe, kann ich immer nur einen neuen Eintrag machen. Dann funktioniert das auch. Wenn ich aber gleich zwei neue Einträge mache (Wobei ich dann auc zwei neue Blätter bekomme und in meiner Liste zwei neue Einträge stehen), auf meinem Tabellenblatt 1 nur das letzte erstelle Blatt benannt wird.

    lochhocker schrieb:

    Was meinst du mit Übersichtsliste?
    Dein Tabellenblatt 1

    lochhocker schrieb:

    Wenn ich mit meiner Userform einen neuen Eintrag in meine Liste mache, erstellt mir Excel ja ein neues Blatt
    Wenn du das Blatt per Code einfügst, solltest du es natürlich in diesem Code gleich in Tabelle1 eintragen.
    Ich dachte, du legst die Sheets manuell neu an.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Meine Liste ist aber das letzte Tabellenblatt. Dort werden auch alle neuen Tabellenblätter eingefügt.
    Auf meinem Blatt 1 werden aber noch mal alle Daten eingefügt.

    Wenn ich jetzt meinen Code in die Liste einsetze und dort ausführe, funktioniert es leider nicht, da es sich (warum auch immer) auf die Liste bezieht und nicht mehr auf das erste Tabellenblatt.

    Du musst halt das Worksheet mit adressieren.

    Wenn du objektorientiert programmierst, kann das sowieso nicht passieren.
    Lege in deinem Worksheet eine Methode an, die den Code im eigenen Context ausführt.
    Sub AddProduct(ByVal Productname as String) 'eintragen End Sub

    Diesen Code kannst du von überall mit Tabelle1.AddProduct("TEST") aufrufen.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Sorry, ich verstehe wirklich nicht, was ich da wie anwenden soll...

    Ich habe jetzt in meinem Worksheet(Tabellenblatt1) folgendes eingetragen:

    VB.NET-Quellcode

    1. Sub AddProduct(ByVal Productname As String)
    2. Dim rngCol As Range, objF As Object, FirstFreeRow As Long, i As Long
    3. Dim isheet As Long
    5. With Worksheets("auswahl")
    6. Set rngCol = .Columns(2) 'Spalte B
    7. Set objF = rngCol.Find("*", SearchDirection:=xlPrevious, lookat:=xlPart)
    8. If Not objF Is Nothing Then
    9. FirstFreeRow = objF.Row + 1
    10. i = FirstFreeRow
    11. For isheet = 4 To Sheets.Count - 1
    12. If WorksheetFunction.CountIf(Range("A:A"), Sheets(isheet).Name) = 1 Then
    13. Cells(i, 1) = ""
    14. Else
    15. If WorksheetFunction.CountIf(Range("A:A"), Sheets(isheet).Name) = 0 Then
    16. Cells(i, 1).Value = Sheets(isheet).Name
    17. Cells(i, 2) = "1"
    18. Cells(i + 1, 2) = "2"
    19. Cells(i + 2, 2) = "3"
    20. Cells(i + 3, 2) = "4"
    21. End If
    22. End If
    23. Next
    24. End If
    25. End With
    26. End Sub


    In meinem letzten Tabellenblatt (Liste) steht jetzt dort, wo auch die neuen Blätter eingefügt werden:

    VB.NET-Quellcode

    1. Private Sub worksheet_change(ByVal Target As Range)
    2. Call hinzufuegen_Hersteller
    3. Call Sortieren_Herstellerliste
    4. Call Eingabe_maske
    5. Call hinzufuegen_Abkuerzung
    7. Dim wksTab As Worksheet
    8. If Target.Column = 4 Then
    9. If Target.Count = 1 And Target.Offset(0, -1) <> "" And Target.Offset(0, 0) <> "" And Target <> "" And Target.Offset(0, -1) <> "" Then
    10. If IsError(Evaluate("'" & Target.Offset(0, 0).Value & Target.Offset(0, -2).Value & Target.Offset(0, -3).Value & "'!" & _
    11. Cells(Rows.Count, Columns.Count).Address)) Then
    12. Set wksTab = ActiveSheet
    13. With Worksheets.Add
    14. .Move after:=Worksheets(Worksheets.Count - 1)
    15. .Name = Target.Offset(0, 1) & " " & Target.Offset(0, -1) & " " & Mid(Target.Offset(0, -3), 8, 3)
    16. End With
    18. wksTab.Activate
    19. Set wksTab = Nothing
    21. Else
    22. MsgBox ("Tabelle schon vorhanden")
    23. End If
    24. End If
    25. End If
    27. End Sub


    Und da soll jetzt dein "Tabelle1.AddProduct("Test")"hin? Wo soll ich das "Test" definieren?

    Edit: Super, du hast mich so auf meinen Fehler gebracht. Die Lösung mag zwar nicht elegant sein, aber sie funktioniert! Danke!

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

    Ich mache mir jetzt nicht die Mühe und versuche deine komplette Datenstruktur zu verstehen, insbesondere da sie sehr wirr zu sein scheint.
    Angenommen, die Produkte sind in Tabelle1 und Tabelle7 gelistet, jeweils in Spalte A.
    Dann trägst du ein beide Tabellen folgenden Code ein:

    Visual Basic-Quellcode

    1. ​Sub AddProduct(ByVal Productname as String)
    2. If Not Range("A:A").Find(Productname,LookIn:=xlValues,LookAt:=xlWhole) Is Nothing Then
    3. r=Cells(Rows.Count,1).End(xlUp).Row+1
    4. Cells(r,1.Value = Productname
    5. ' usw.
    6. End If
    7. End Sub

    Und in deiner Form, wo das Produkt angelegt wird rufst einfach auf

    Visual Basic-Quellcode

    1. Productname = "NeuProdukt"
    2. Set ws = Worksheets.Add
    3. ws.Name = ProductName
    4. Tabelle1.AddProduct(Productname)
    5. Tabelle7.AddProduct(Productname)

    Deine komischen With-Konstrukte kannst du alle in der Pfeife rauchen.
    Du brauchst auch keine Events, wenn du das nur einmal aus der Form raus aufrufst.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    So ganz verstehe ich deinen Code allerdings auch nicht. Trotzdem vielen Dank für die Mühen. Das Problem ist ja zum Glück gelöst.

    Mein Problem ist jetzt, dass ich aus meinen Tabellenblätter 4 bis Sheets.count-1 bestimmte Inhalte brauche. Diese sollten dann in den jeweiligen Tabellenblättern 4 bis Blatt -1 seperat aufgeschrieben werden. Es geht dabei immer um die vier gleichen Ranges (Also als Beispiel: A16:C20; A30:C34 usw.). Diese sollten dann z.B. ab Zeile E-G untereinander aufgeschrieben werden.
    So ist es bisher gelöst, was natürlich alles andere als elegant ist.

    VB.NET-Quellcode

    1. Private Sub Werte_auswaehlen()
    3. Dim i As Long
    4. For i = 4 To Sheets.Count - 1
    5. Worksheets(i).Range("E1:G5").Value = Worksheets(i).Range("A19:C23").Value
    6. Worksheets(i).Range("E6:G10").Value = Worksheets(i).Range("A60:C64").Value
    7. Worksheets(i).Range("E11:G15").Value = Worksheets(i).Range("A101:C105").Value
    8. Worksheets(i).Range("E16:G20").Value = Worksheets(i).Range("A142:C146").Value
    9. Worksheets(i).Range("E21:G25").Value = Worksheets(i).Range("A183:C187").Value
    10. Worksheets(i).Range("E26:G30").Value = Worksheets(i).Range("A224:C228").Value
    11. Worksheets(i).Range("E31:G35").Value = Worksheets(i).Range("A265:C269").Value
    12. Worksheets(i).Range("E36:G40").Value = Worksheets(i).Range("A306:C310").Value
    13. Next i
    14. End Sub


    Für eine andere Variante

    VB.NET-Quellcode

    1. Private Sub Berechnungen_ausfuehren()
    2. Dim i As Long
    3. Dim irow As Long, iRows As Long
    5. iRows = Range("B65536").End(xlUp).Row
    6. For i = 4 To Sheets.Count - 1
    7. For irow = 2 To iRows
    8. If WorksheetFunction.CountIf(Range("A:A"), Sheets(i).Name) = 1 And _
    9. Cells(irow, 2) = "1" Then
    10. Worksheets("Reifenauswahl").Cells(irow, 15) = Worksheets(i).Cells(2, 2).Value
    11. End If
    12. Next
    13. Next
    15. End Sub


    Wobei hier nur die das i-te Tabellenblatt ausgeführt wird. Sprich, überall in meiner Liste, wo eine 1 steht, steht de Wert aus dem i-ten Tabellenblatt. Ich möchte aber die Zugehörigkeit zu dem benannten Blatt, welches in Spalte A steht.

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

Facebook
Telefonspende