AW: gern geschehen
16.06.2016 15:34:56
Rene
Hallo Michael,
Danke nochmal jetzt habe ich aber ein Problem, ich habe den Wortstamm gefüllt und auch den Makro von 9 auf 856 erhöht, bei Reiter I (Plan DBS) ist alles korrekt aber bei Reiter III (Archiv) macht er mir "xxx". Kannst du mir helfen. Anbei der Code?
Option Explicit
Sub WS_zuordnenH()
Call WS_zu("H", Plan)
End Sub
Sub WS_zuordnenI()
Call WS_zu("P", Archiv)
End Sub
Sub WS_zu(sp As String, sh As Worksheet)
Dim aWS
Dim maxz&, i&, r1&, maxWS&
Dim c As Range, suchIn As Range
maxz = sh.Range("A" & Plan.Rows.Count).End(xlUp).Row
sh.Range(sp & 2).Resize(maxz).ClearContents
maxWS = WS.Range("A" & Plan.Rows.Count).End(xlUp).Row
WS.Range("B1").Resize(maxWS, 2).ClearContents
aWS = WS.Range("A1").Resize(maxWS, 2)
Set suchIn = sh.Range("B1").Resize(maxz)
For i = 1 To 856
Set c = suchIn.Find(aWS(i, 1), sh.Range("B1"), xlValues, xlPart)
If Not c Is Nothing Then
r1 = c.Row
Do
sh.Range(sp & c.Row).Value = aWS(i, 1)
If sp = "P" Then aWS(i, 2) = aWS(i, 2) & "," & c.Row
Set c = suchIn.FindNext(c)
Loop While Not c Is Nothing And c.Row r1
End If
Next
If sp = "P" Then WS.Range("A1").Resize(maxWS, 2) = aWS
End Sub