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.
