AW: Langer String mit Abkürzungen übersetzen
21.11.2016 21:09:19
Matthias
Hallo zusammen,
ich habe versucht den Vorschlag von Mullit anzupassen, es klappt aber noch nicht so ganz bei 2 Dingen:
1. Wie bekomme ich die Schleife zum laufen, so dass mir für jede neue Zelle die ich durchlaufe die Variablen zurückgesetzt werden!?
Ansonsten wird mein String immer länger da alles von davor noch mit hineingewurschtelt wird.
2. Problem macht mir noch "For ialngSlash = 0 To 1" - Wenn ich einen Slash habe klappt es, bei mehreren nicht, dann muss ich das 0 To x anpassen. Wie mache ich das Variabel egal wieviele Slashs ich habe?
Vielen Dank!!!
Dim wksSearchSheet As Worksheet
Dim objCell As Range
Dim astrArray() As String
Dim strNewText As Variant, strSlashText As String
Dim ialngIndex As Long, ialngSlash As Long
Dim letzteZeile_VGL As Long
Dim Spalte As Long, Zeile As Long
Set wksSearchSheet = Tabelle1 '// hier Dein Suchblatt anpassen...
letzteZeile_VGL = Cells(Rows.Count, 2).End(xlUp).Row 'letzte Zeile
For Spalte = 4 To 5
For Zeile = 1 To letzteZeile_VGL
'Variablen zurücksetzen
With Cells(Zeile, Spalte) '// hier Deine String-Zelle anpassen...
.Select
If .Value vbNullString Then
astrArray() = Split(Expression:=.Value, Delimiter:="+", Compare:=vbTextCompare)
For ialngIndex = 0 To UBound(astrArray)
If astrArray(ialngIndex) vbNullString Then
If InStr(1, astrArray(ialngIndex), "/", vbTextCompare) 0 Then
For ialngSlash = 0 To 5
strSlashText = Split(Expression:=astrArray(ialngIndex), Delimiter:="/", _
Compare:=vbTextCompare)(ialngSlash)
Set objCell = wksSearchSheet.Cells.Find(What:=strSlashText, LookIn:= _
xlValues, LookAt:=xlWhole, MatchCase:=False)
If objCell Is Nothing Then
strNewText = strNewText & strSlashText & ": " & "*NICHT VORHANDEN*" & _
IIf(ialngSlash = 0, " ODER ", " ODER ") & Chr(10)
Else
strNewText = strNewText & strSlashText & ": " & objCell.Offset(0, 1). _
Value & IIf(ialngSlash = 0, " ODER ", " ODER ") & Chr(10)
Set objCell = Nothing
End If
Next
Else
Set objCell = wksSearchSheet.Cells.Find(What:=astrArray(ialngIndex), _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If objCell Is Nothing Then
strNewText = strNewText & astrArray(ialngIndex) & ": " & "*NICHT _
VORHANDEN*" & " UND " & Chr(10)
Else
strNewText = strNewText & astrArray(ialngIndex) & ": " & objCell.Offset( _
0, 1).Value & " UND " & Chr(10)
Set objCell = Nothing
End If
End If
End If
Next
If strNewText vbNullString Then
If Not .Comment Is Nothing Then Call .Comment.Delete
Call .AddComment(Text:=strNewText)
End If
Else
GoTo Ende
End If
End With
Set wksSearchSheet = Nothing
Ende:
Next Zeile
Next Spalte