Sub unsinn_loeschen()
Dim liLineCounter As Double
Dim lsString As String
Dim lwSheet1 As Worksheet
Set lwSheet1 = ActiveWorkbook.Worksheets("Sheet1")
For liLineCounter = 1 To Worksheets("Sheet1").UsedRange.Rows.Count
lsString = lwSheet1.Range("A" & liLineCounter).Value
While Left(lsString, 1) = " " Or Left(lsString, 1) = "|"
lsString = Right(lsString, Len(lsString) - 1)
Wend
If lsString = "" Then
lwSheet1.Rows(liLineCounter).Delete
End If
Next liLineCounter
End Sub
Jetzt habe ich gemerkt, das es doch Vorgangsnummern gibt, die mit Einem Buchstaben beginnen und danneine neunstellige Zahl folgt (ohne Leerzeichen). Die Nummern können Zahlen und Buchstaben enthalten.
Hast du dafür auch noch eine Lösung.
Wenn das noch klappen würde, wäre es absolut perfekt
Jetzt habe ich gemerkt, das es doch Vorgangsnummern gibt, die mit Einem Buchstaben beginnen und danneine neunstellige Zahl folgt (ohne Leerzeichen). Die Nummern können Zahlen und Buchstaben enthalten.
Hast du dafür auch noch eine Lösung.
Wenn das noch klappen würde, wäre es absolut perfekt
Im Ernst ... wenn es tatsächlich passiert, dass nicht klar ist, ob es sich um eine neustellige oder zehnstellige alphanumerische Kombination handelt, wird es kompliziert.
Frage: ist sichergestellt, dass NACH der Kombination (egal ob neun- oder zehnstellig) IMMER mindestens EIN Leerzeichen kommt?
WENN immer nach der Kombination (egal, ob 9- oder 10-stellig)ein Leerzeichen kommt :
Code:
Sub Erklaeren()
Dim lwSheet1 As Worksheet
Dim lwSheet2 As Worksheet
Dim lsErklaerung As String
Dim lsSuchString As String
Dim liLineCount1 As Double
Dim liLineCount2 As Double
Dim liStringCount As Integer
Dim liStringLenght As Integer
Set lwSheet1 = ActiveWorkbook.Worksheets("Sheet1")
Set lwSheet2 = ActiveWorkbook.Worksheets("Sheet2")
For liLineCount1 = 5 To lwSheet1.UsedRange.Rows.Count
lsSuchString = lwSheet1.Range("A" & liLineCount1).Value
liStringLenght = Len(lsSuchString)
For liStringCount = 1 To liStringLenght
If Left(lsSuchString, 1) = "-" Or lsSuchString = "" Then
Exit For
Else
lsSuchString = Right(lsSuchString, Len(lsSuchString) - 1)
End If
Next liStringCount
If lsSuchString = "" Then
GoTo naechster 'String genügt nicht den Anforderungen (enthält kein "-")
End If
lsSuchString = Right(lsSuchString, Len(lsSuchString) - 2) 'die führenden zwei "-" wegschneiden
lsSuchString = CStr(Left(lsSuchString, 10)) 'jetzt haben wir den Suchbegriff auf jeden Fall als String vorliegen
If Right(lsSuchString, 1) = " " Then
lsSuchString = Left(lsSuchString, 9) 'kann 9- oder 10-stellig alphanumerisch sein
End If
For liLineCount2 = 1 To lwSheet2.UsedRange.Rows.Count 'suchen
If lsSuchString = lwSheet2.Range("A" & liLineCount2).Value Then 'gefunden
lwSheet1.Range("B" & liLineCount1).Value = lwSheet2.Range("B" & liLineCount2).Value 'eintragen
Exit For 'nächste Zeile aus Sheet1
End If
Next liLineCount2
naechster:
Next liLineCount1
End Sub
Ich hatte mein Skript angepasst und eigentlich sollte das Skript auch 10-stellige Vorgangsnummern bearbeiten.
Findest du hier einen Fehler?
Code:
Sub VGN()
Application.ScreenUpdating = False
Dim lwSheet1 As Worksheet
Dim lwSheet2 As Worksheet
Dim lsErklaerung As String
Dim lsSuchString As String
Dim liLineCount1 As Double
Dim liLineCount2 As Double
Dim liStringCount As Integer
Dim liStringLenght As Integer
Set lwSheet1 = ActiveWorkbook.Worksheets("Sheet1")
Set lwSheet2 = ActiveWorkbook.Worksheets("Sheet2")
For liLineCount1 = 1 To lwSheet1.UsedRange.Rows.Count
lsSuchString = lwSheet1.Range("A" & liLineCount1).Value
liStringLenght = Len(lsSuchString)
For liStringCount = 1 To liStringLenght
If Mid(lsSuchString, liStringCount, 1) = "-" Then
n = liStringCount
End If
Next liStringCount
If lsSuchString = "" Then
GoTo naechster 'String genügt nicht den Anforderungen (enthält kein "-")
End If
lsSuchString = Mid(lsSuchString, n + 1, liStringLenght) 'die führenden zwei "-" wegschneiden
lsSuchString = Trim(lsSuchString)
For liStringCount = 1 To Len(lsSuchString)
If Mid(lsSuchString, liStringCount, 1) = " " Then
n = liStringCount
Exit For
End If
Next liStringCount
lsSuchString = Mid(lsSuchString, 1, n - 1)
With Worksheets("Sheet2").Columns(1)
Set r = .Find(what:="" & lsSuchString & "", searchdirection:=xlNext, MatchCase:=True)
If r Is Nothing Then m = "nicht gefunden" Else r = r.Row
End With
If m = Empty Then lwSheet1.Range("B" & liLineCount1).Value = lwSheet2.Range("B" & r).Value Else lwSheet1.Range("B" & liLineCount1).Value = m
m = Empty
naechster:
Next liLineCount1
Application.ScreenUpdating = True
End Sub
ich verstehe zwar, dass Du Dir das "Abschneiden" links und rechts schenken willst, indem Du "mid" / "trim" verwendest, das kann aber nicht funltionieren, da Du geschrieben hattest, dass Du verschiedene Anzahlen von " | | |" hast. Die sind auch so in Deinem Beispiel.
Nimm lieber die etwas längere Laufzeit von dem Makro in Kauf, das ich Dir geschickt hatte. So wie Du das versuchst, wird das nicht funltionieren.
Dein Ansatz ist nur dann sinnvoll, wnn Du - wie in Deinem Fall eben nicht - immer an der selben Stelle Deinen "Zuordnungsnummer" findest.
danke für die Info. Das habe ich gar nicht bedacht. Dein Makro läuft wirklich einwandfrei. Bin gerade nochmal dabei es durchlaufen zu lassen. Dauert noch ein paar Stunden bis es fertig ist.
Navigation
Linear-Darstellung
