Hallo Herber Gemeinde,

ich habe folgendes Problem:

im Tabellenblatt Kundenliste (Tabellenbezeichnung "Kunden"), in Spalte J ab Zeile 5 steht eine Zahl von 1-4 oder UVV drin,
diese Spalte J habe ich schon in "Text, Standard oder Zahlen Formatieren lassen von VBA" ich bekomme da aber immer ein Problem wenn ich über VBA eine suche starte.
Ich muss nachträglich den Wert in Spalte J erneut eingeben zB die 1 ist hinterlegt/ kopiert ...., (ohne dem Grünen Dreieck am oberen liken Rand) dann muss ich die 1 löschen/ ersetzen und erneut eingeben, es wird dann ein Günes Dreieck am oberen liken Rand angezeigt was mir eigentlich einen Fehler aufweist, in meinem Fall " in Zahl umgewandelt werden", mache ich dass gehen der folgenden Code nicht mehr, nur wenn das Grüne Dreieck "Fehler" vorhanden ist werden oder wird alles korrekt berechnet.
Wie schon gesagt, habe ich die Spalte J schon in verschiedene Formate formatiert.

Der VBA Code/ Schaltfläche im Tabellenblatt Wartung zur Suche:

Sub KopiereKundenMitSG()
Dim wsKunden As Worksheet
Dim wsWartung As Worksheet
Dim letzteZeileKunden As Long
Dim letzteZeileWartung As Long
Dim i As Long
Dim j As Long
Dim gefunden As Boolean
Dim zuBehalten As Boolean

' Arbeitsblätter zuweisen
Set wsKunden = ThisWorkbook.Sheets("Kundenliste")
Set wsWartung = ThisWorkbook.Sheets("Wartung")

' Spalte J im Tabellenblatt Kundenliste als Text formatieren
wsKunden.Columns("J").NumberFormat = "@" ' Textformat setzen

' Alle Zeilen ab A6 bis zum Ende in der Wartung löschen
wsWartung.Rows("6:" & wsWartung.Rows.Count).ClearContents

' Letzte Zeile in der Kundenliste finden
letzteZeileKunden = wsKunden.Cells(wsKunden.Rows.Count, "L").End(xlUp).Row

' Doppelte Einträge in der Wartungsliste entfernen
letzteZeileWartung = wsWartung.Cells(wsWartung.Rows.Count, "A").End(xlUp).Row
For i = letzteZeileWartung To 1 Step -1
gefunden = False
For j = 1 To i - 1
If wsWartung.Cells(i, "A").Value = wsWartung.Cells(j, "A").Value Then
gefunden = True
Exit For
End If
Next j
If gefunden Then wsWartung.Rows(i).Delete
Next i

' Durchlaufe die Zeilen in der Spalte L
For i = 1 To letzteZeileKunden
' Überprüfen, ob der Wert in Spalte L "SG" ist
If wsKunden.Cells(i, "L").Value = "SG" Then
' Letzte Zeile in der Wartungsliste finden
letzteZeileWartung = wsWartung.Cells(wsWartung.Rows.Count, "A").End(xlUp).Row + 1
' Wert aus Spalte A kopieren
wsWartung.Cells(letzteZeileWartung, "A").Value = wsKunden.Cells(i, "A").Value
End If
Next i

' Zeilen in der Wartung löschen, wenn in Spalte K nicht "1", "2", "3", "4" oder "UVV"
letzteZeileWartung = wsWartung.Cells(wsWartung.Rows.Count, "A").End(xlUp).Row
For i = letzteZeileWartung To 6 Step -1
zuBehalten = False
If wsWartung.Cells(i, "K").Value = "1" Or _
wsWartung.Cells(i, "K").Value = "2" Or _
wsWartung.Cells(i, "K").Value = "3" Or _
wsWartung.Cells(i, "K").Value = "4" Or _
wsWartung.Cells(i, "K").Value = "UVV" Then
zuBehalten = True
End If
If Not zuBehalten Then wsWartung.Rows(i).Delete
Next i

' Wartungsliste ab B5 aufsteigend sortieren
With wsWartung.Sort
.SortFields.Clear
.SortFields.Add Key:=wsWartung.Range("B5:B" & wsWartung.Cells(wsWartung.Rows.Count, "B").End(xlUp).Row), _
Order:=xlAscending
.SetRange wsWartung.Range("A5:B" & wsWartung.Cells(wsWartung.Rows.Count, "B").End(xlUp).Row)
.Header = xlYes
.Apply
End With

' Spaltenbreite anpassen und Zeilenhöhe einstellen
wsWartung.Columns.AutoFit
wsWartung.Rows("6:" & wsWartung.Rows.Count).RowHeight = 20 ' Zeilenhöhe auf 20 setzen

MsgBox "Alle Wartungen für Stefan sind aufgelistet", vbInformation
End Sub

Zum ändern oder anlegen von Kunden im Tabellenblatt ABL benutze ich folgende Codes:
(diese wenden zusammengefast, in einer Schaltfläche)

Sub CheckKunde()
Dim vntRow As Variant
Dim vntRet As Variant

' Überprüfen, ob D9 leer ist
If IsEmpty(Range("D9").Value) Then
MsgBox "Im Feld D9 ist keine Maschienennummer.", vbExclamation, "Eingabefehler"
Exit Sub
End If

' Suche nach dem Kunden in der Kundenliste
vntRow = Application.Match(Range("D9").Value, Sheets("kundenliste").Columns(1), 0)

If IsError(vntRow) Then ' Kunde nicht vorhanden
vntRet = MsgBox("Neuer Kunde" & vbLf & "Daten ändern?", vbInformation + vbYesNo, "Gebe bekannt...")
If vntRet = vbYes Then
Call Eintragen(True, 0)
MsgBox "Kunde angelegt", vbInformation, "Gebe bekannt..."
Else
MsgBox "Abbruch", vbInformation, "Gebe bekannt..."
End If
Else ' Kunde bereits vorhanden
vntRet = MsgBox("Kunde bereits vorhanden!" & vbLf & "Daten ändern?", vbInformation + vbYesNo, "Gebe bekannt...")
If vntRet = vbYes Then
Call Eintragen(False, CLng(vntRow))
End If
End If
End Sub


Sub Eintragen(bolNeu As Boolean, lngRow As Long)
With Worksheets("kundenliste")
If bolNeu Then
lngRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
.Cells(lngRow, 1) = Range("D9")
.Cells(lngRow, 2) = Range("C13")
.Cells(lngRow, 3) = Range("C15")
.Cells(lngRow, 4) = Range("C17")
.Cells(lngRow, 5) = Range("C19")
.Cells(lngRow, 6) = Range("C21")
.Cells(lngRow, 7) = Range("C23")
.Cells(lngRow, 8) = Range("F13")
.Cells(lngRow, 9) = Range("F15")
.Cells(lngRow, 10) = Range("F17")
.Cells(lngRow, 11) = Range("F19")
.Cells(lngRow, 12) = Range("F21")
.Cells(lngRow, 13) = Range("F23")
.Cells(lngRow, 14) = Range("F25")
.Cells(lngRow, 15) = Range("C25")
.Cells(lngRow, 16) = Range("C27")
End With
Dim rngZelle As Range, rngSrc As Range

Set rngSrc = Range("D9")
If Not rngSrc.MergeCells Then
rngSrc.ClearContents
Else
For Each rngZelle In rngSrc
rngZelle.MergeArea.ClearContents
Next
End If
Call FormelnRein
End Sub

Sub FormelnRein()
With Worksheets("ABL")
.Range("C13").FormulaLocal = "=WENNNV(SVERWEIS(D9;Kundenliste!A5:P929;2;FALSCH);)"
.Range("C15").FormulaLocal = "=WENNNV(SVERWEIS(D9;Kundenliste!A5:P929;3;FALSCH);)"
.Range("C17").FormulaLocal = "=WENNNV(SVERWEIS(D9;Kundenliste!A5:P929;4;FALSCH);)"
.Range("C19").FormulaLocal = "=WENNNV(SVERWEIS(D9;Kundenliste!A5:P929;5;FALSCH);)"
.Range("C21").FormulaLocal = "=WENNNV(SVERWEIS(D9;Kundenliste!A5:P929;6;FALSCH);)"
.Range("C23").FormulaLocal = "=WENNNV(SVERWEIS(D9;Kundenliste!A5:P929;7;FALSCH);)"
.Range("C25").FormulaLocal = "=WENNNV(SVERWEIS(D9;Kundenliste!A5:P929;15;FALSCH);)"
.Range("C27").FormulaLocal = "=WENNNV(SVERWEIS(D9;Kundenliste!A5:P929;16;FALSCH);)"
.Range("F13").FormulaLocal = "=WENNNV(SVERWEIS(D9;Kundenliste!A5:P929;8;FALSCH);)"
.Range("F15").FormulaLocal = "=WENNNV(SVERWEIS(D9;Kundenliste!A5:P929;9;FALSCH);)"
.Range("F17").FormulaLocal = "=WENNNV(SVERWEIS(D9;Kundenliste!A5:P929;10;FALSCH);)"
.Range("F19").FormulaLocal = "=WENNNV(SVERWEIS(D9;Kundenliste!A5:P929;11;FALSCH);)"
.Range("F21").FormulaLocal = "=WENNNV(SVERWEIS(D9;Kundenliste!A5:P929;12;FALSCH);)"
.Range("F23").FormulaLocal = "=WENNNV(SVERWEIS(D9;Kundenliste!A5:P929;13;FALSCH);)"
.Range("F25").FormulaLocal = "=WENNNV(SVERWEIS(D9;Kundenliste!A5:P929;14;FALSCH);)"
End With
Range("D9").Select
End Sub

Das Ändern der Letzen Wartung oder die Anzahl der Wartungen führe ich im ABL Tabellenblatt oder mit dem Makro im Tabellenblatt Wartung aus.

Sub KopiereWartungDaten()
Dim wsKundenliste As Worksheet
Dim wsWartung As Worksheet
Dim suchBegriff As String
Dim letzteZeile As Long
Dim i As Long
Dim gefunden As Boolean

' Setze die Arbeitsblätter
Set wsKundenliste = ThisWorkbook.Sheets("Kundenliste")
Set wsWartung = ThisWorkbook.Sheets("Wartung")

' Überprüfe, ob in E2 ein Wert steht
If IsEmpty(wsWartung.Range("E2").Value) Then
MsgBox "Die Zelle E2 = Maschienennummer ist LEER", vbExclamation
Exit Sub
End If

' Definiere den Suchbegriff
suchBegriff = wsWartung.Range("E2").Value

' Finde die letzte Zeile in der Kundenliste
letzteZeile = wsKundenliste.Cells(wsKundenliste.Rows.Count, 1).End(xlUp).Row

' Setze gefunden auf False
gefunden = False

' Durchlaufe die Kundenliste
For i = 1 To letzteZeile
' Überprüfe, ob der Wert in Spalte A mit dem Suchbegriff übereinstimmt
If wsKundenliste.Cells(i, 1).Value = suchBegriff Then
gefunden = True ' Setze gefunden auf True
' Kopiere die Werte von Wartung F2 und G2 in die Kundenliste
wsKundenliste.Cells(i, 11).Value = wsWartung.Range("F2").Value ' Kopiere nach Spalte K (11)
wsKundenliste.Cells(i, 10).Value = wsWartung.Range("G2").Value ' Kopiere nach Spalte J (10)
End If
Next i

' Überprüfe, ob der Suchbegriff gefunden wurde
If gefunden Then
MsgBox "Daten wurden erfolgreich aktualisiert", vbInformation
Else
MsgBox "Die Maschienennummer '" & suchBegriff & "' wurde nicht in der Kundenliste gefunden, Bitte als neuen Kunden in ABL anlegen", vbExclamation
End If

' Lösche die Inhalte in den Zellen F2 und G2 im Tabellenblatt "Wartung"
wsWartung.Range("F2").ClearContents
wsWartung.Range("G2").ClearContents

' Füge die Formel in G2 ein
wsWartung.Range("G2").Formula = "=G3"
End Sub

Vielleicht könnt ihr da Helfen, warum die Formatierung in der Kundenliste bei Änderungen nicht übernommen oder angepasst wird.

Vielen Dank für eure Hilfe, ich sehe den Wald vor lauter Bäumen nicht :-( ,was muss ich ändern damit immer im Text, Standard, .... Format gearbeitet wird oder der Code:
Sub KopiereKundenMitSG() korrekt funktioniert.

Gruß
Stefan