der VBA Code hat soweit geklappt. Nur hat sich meine Arbeitsmappe verändert. Es kommen jetzt weitere Blätter hinzu und der Code scheint nicht mehr klar zu wissen wo er suchen muss und vor allem wo er einfügen muss. Er rechnet zwar etwas, dann kommt aber kein Ergebnis (zumindest kein für mich sichtbares).
Any thoughts wie man den Code anpassen kann um ihn auf (in meinem Beispiel) jetzt auf Tabelle5 (Arbeitsblatt "Stammdaten") weisen zu lassen? Die Tablelle mit den vorgegebenen Suchbegriffen war ja im Code klar definiert und kann leicht geändert werden.
Sub Arbeitsplangruppenzuordnung() Dim lngZ As Long, i As Long Dim Zelle As Range Dim rngFound As Range Dim firstAddress As String Dim wks As Worksheet Set wks = Sheets("Stammdaten")
Application.ScreenUpdating = False With wks lngZ = .Cells(.Rows.Count, 3).End(xlUp).Row .Range("E4:E" & lngZ).ClearContents End With For Each Zelle In wks.Range("Tabelle5") If Zelle <> "" Then With wks.Range("C4:C" & lngZ) Set rngFound = .Find(Zelle, LookIn:=xlValues, lookat:=xlPart) If Not rngFound Is Nothing Then firstAddress = rngFound.Address wks.Cells(rngFound.Row, 5) = wks.Cells(Zelle.Row, 7).Value Do Set rngFound = .FindNext(rngFound) If Not rngFound Is Nothing Then wks.Cells(rngFound.Row, 5) = wks.Cells(Zelle.Row, 7) End If Loop While Not rngFound Is Nothing And rngFound.Address <> firstAddress End If End With End If Next Zelle Application.ScreenUpdating = True End Sub
Sub Arbeitsplangruppenzuordnung() Dim lngZ As Long, i As Long Dim Zelle As Range Dim rngFound As Range Dim firstAddress As String Dim wks As Worksheet Set wks = Sheets("Stammdaten")
Application.ScreenUpdating = False With wks lngZ = .Cells(.Rows.Count, 3).End(xlUp).Row .Range("E4:E" & lngZ).ClearContents End With For Each Zelle In wks.Range("Tabelle5") If Zelle <> "" Then With wks.Range("C4:C" & lngZ) Set rngFound = .Find(Zelle, LookIn:=xlValues, lookat:=xlPart) If Not rngFound Is Nothing Then firstAddress = rngFound.Address wks.Cells(rngFound.Row, 5) = wks.Cells(Zelle.Row, 7).Value Do Set rngFound = .FindNext(rngFound) If Not rngFound Is Nothing Then wks.Cells(rngFound.Row, 5) = wks.Cells(Zelle.Row, 7) End If Loop While Not rngFound Is Nothing And rngFound.Address <> firstAddress End If End With End If Next Zelle Application.ScreenUpdating = True End Sub
Nee, der lässt mein EXEL abschmieren...(Keine Rückmeldung für länger als 15min) Hast du noch eine andere Idee?
gehe ich davon aus, dass Tabelle5 die Wertetabelle ist in der die einzelnen Bgriffe stehen und nach diese in Spalte C in Tabelle "Stammdaten" gesucht wird.
Wenn diese anders heißt oder sich nicht in Stammdaten befindet, dann musst Du einmal den Namen anpassen und zum zweiten den Bezug zu Stammdaten lösen.
Angenommen die Tabelle hieße Tabelle59, dann änder die Zeile so um:
gehe ich davon aus, dass Tabelle5 die Wertetabelle ist in der die einzelnen Bgriffe stehen und nach diese in Spalte C in Tabelle "Stammdaten" gesucht wird.
Wenn diese anders heißt oder sich nicht in Stammdaten befindet, dann musst Du einmal den Namen anpassen und zum zweiten den Bezug zu Stammdaten lösen.
Angenommen die Tabelle hieße Tabelle59, dann änder die Zeile so um:
Code:
For Each Zelle In Range("Tabelle59")
Hallo Atilla,
ich habe alles so angepasst wie ich denke das es funktioniert. Leider ist mein Wissen in VB zu gering dass ich meine Fehler selbst korrigieren kann. Was mich allgemein in EXEL durcheinander bringt, ist die Tabellennummerierung in Bezug auf die Arbeitsblattnamen. Diese scheinen irgendwie miteinander Verknüpft. Also hier noch mal meine Originaltabelle wie ich momentan damit arbeite. Leer geräumt und nur für unseren Test die relevanten Daten enthalten. Ich denke wir können wieder zurück auf die Tabellennummern zugreifen. Damit sollte es ja auch klar definierbar sein. Das ist ja für die Wertetabelle (Tabelle59) auch schon so. Wenn du dann die Arbeitstabelle (Tabelle5) auch im Code definierst sollte es doch keine Missverständnisse mehr geben oder?!
Sub Arbeitsplangruppenzuordnung() Dim lngZ As Long, i As Long Dim Zelle As Range Dim rngFound As Range Dim firstAddress As String Dim wks As Worksheet Set wks = Sheets("Stammdaten")
Application.ScreenUpdating = False With wks lngZ = .Cells(.Rows.Count, 3).End(xlUp).Row .Range("F4:F" & lngZ).ClearContents End With For Each Zelle In Range("Tabelle59") If Zelle <> "" Then With wks.Range("C4:C" & lngZ) Set rngFound = .Find(Zelle, LookIn:=xlValues, lookat:=xlPart) If Not rngFound Is Nothing Then firstAddress = rngFound.Address wks.Cells(rngFound.Row, 6) = Range("Tabelle59").Cells(Zelle.Row - 1, 1).Value Do Set rngFound = .FindNext(rngFound) If Not rngFound Is Nothing Then wks.Cells(rngFound.Row, 6) = Range("Tabelle59").Cells(Zelle.Row - 1, 1).Value End If Loop While Not rngFound Is Nothing And rngFound.Address <> firstAddress End If End With End If Next Zelle Application.ScreenUpdating = True End Sub
Sub Arbeitsplangruppenzuordnung() Dim lngZ As Long, i As Long Dim Zelle As Range Dim rngFound As Range Dim firstAddress As String Dim wks As Worksheet Set wks = Sheets("Stammdaten")
Application.ScreenUpdating = False With wks lngZ = .Cells(.Rows.Count, 3).End(xlUp).Row .Range("F4:F" & lngZ).ClearContents End With For Each Zelle In Range("Tabelle59") If Zelle <> "" Then With wks.Range("C4:C" & lngZ) Set rngFound = .Find(Zelle, LookIn:=xlValues, lookat:=xlPart) If Not rngFound Is Nothing Then firstAddress = rngFound.Address wks.Cells(rngFound.Row, 6) = Range("Tabelle59").Cells(Zelle.Row - 1, 1).Value Do Set rngFound = .FindNext(rngFound) If Not rngFound Is Nothing Then wks.Cells(rngFound.Row, 6) = Range("Tabelle59").Cells(Zelle.Row - 1, 1).Value End If Loop While Not rngFound Is Nothing And rngFound.Address <> firstAddress End If End With End If Next Zelle Application.ScreenUpdating = True End Sub
So, diesmal ist es durch gerockt. Meine Daten sind einsortiert. DANKE!!
Ich hab mir die Änderungen im Code auch schon angeguckt. Wenn man es dann sieht macht es auch Sinn...nur erst mal drauf kommen. Ich hoffe das ich es hiermit dann auch bei weiteren Änderungen selbst hin kriege. Auf jeden Fall nochmal danke an Alle für die Hilfe.
