Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 21:55:37
Preiserhöhung über mehrere Jahre berechnen
17.04.2024 20:19:32
Endzeitpunkt berechnen aus d:hh:mm errechnen
17.04.2024 18:57:33
Errinnerungsfunktion
17.04.2024 16:56:58
Stunden addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1760to1764
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1760to1764
1760to1764
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zellinhalte nach Fehlern überprüfen?

Zellinhalte nach Fehlern überprüfen?
31.05.2020 13:07:13
Sergej
Hallo Leute,
ich habe hier ein Ausschnitt meiner Excel-Datei beigefügt. https://www.herber.de/bbs/user/137906.xlsx
Ich habe im Arbeitsblatt "VORHER" in Spalte A sehr langen Zellinhalte, die ich inhaltlich auf Fehlern überprüfen möchte.
In den Zellen soll immer nach Zeichen [ gesucht werden, dann soll geprüft werden, ob davor @ steht, usw. bis Ende des Zellinhalts.
Wenn vor dem [ kein @ steht, dann soll die Klammer [ in Rot mit Schriftgröße 16 und fett dargestellt werden.
Die Spalte B soll in ROT ansonsten in GRÜN (wenn keine Fehler gefunden) dargestellt werden.
Ich habe im Arbeitsblatt "NACHHER" für die Verdeutlichung das Endergebnis dargestellt.
Wie mache ich das bitte per VBA? Das würde mir sehr viel Arbeit sparen.
Vielen herzlichen Dank im Voraus.
Beste Grüße,
Sergej

26
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Beispieldatei ist unlogisch
31.05.2020 13:42:19
Martin
Hallo Sergej,
leider ist entweder deine Erklärung falsch oder ein Fehler in deinem Beispiel enthalten. In der _ Zelle A2 steht unter anderem: 

[PT]Absperrhahn geschraubt PN16 [$2452]@
Nach deiner Erklärung fehlt ein @-Zeichen zwischen [PT] und [$2452], aber laut deiner Beispieldatei ist alles in Ordnung.
Viele Grüße
Martin
Adlerauge ;-)
31.05.2020 13:51:23
Matthias
.
AW: Zellinhalte nach Fehlern überprüfen?
31.05.2020 13:43:22
onur
Und wieso ist bei deinem Beispiel in Zeile 2 bei
"...... [$2452]@[PN]16@[CI]daten:sani_armaturen:KGHHE...." die Klammer vor "$2452" NICHT rot und gross?
AW: Zellinhalte nach Fehlern überprüfen?
31.05.2020 13:50:28
Oberschlumpf
weil er es vielleicht übersehen haben könnte?!?
Anzeige
AW: Zellinhalte nach Fehlern überprüfen?
31.05.2020 13:51:41
Sergej
Hallo Onur, hallo Martin,
ihr habt es sehr genau gesehen :-)
Das ist eine Ausnahme, die ich in meiner Nachricht vergessen habe.
Wenn vor [ kein @ steht aber [$ nach steht, dann ist es noch in Ordnung.
Also wenn $-Zeichen da ist, dann passt es noch...
Beste Grüße,
Sergej
AW: Zellinhalte nach Fehlern überprüfen?
31.05.2020 13:54:48
onur
Willst du mich auf den Arm nehmen?
WAS hast du noch alles vergesen zu erwähnen ?
AW: Zellinhalte nach Fehlern überprüfen?
31.05.2020 14:08:04
Oberschlumpf
unterhalb von 
With Cells(z, 1).Characters(Start:=pos, Length:=1).Font

fehlt noch 
.Bold = True
nur als kleiner Tipp
Anzeige
AW: Zellinhalte nach Fehlern überprüfen?
31.05.2020 14:09:29
onur
Das mit "FETT" habe ich überlesen - Danke !
AW: Zellinhalte nach Fehlern überprüfen?
31.05.2020 19:40:48
Sergej
Hallo Onur,
ich habe es jetzt getestet und es funktioniert prima. Vielen Dank!
Was muss ich bitte im Code noch ergänzen, damit der Inhalt zwischen [GUID]........ und @-Zeichen etwas großer und in Blau angezeigt wird. Es betrifft alle Zellinhalte in Spalte A...
Nachher:
Beste Grüße,
Sergej
AW: Zellinhalte nach Fehlern überprüfen?
31.05.2020 20:09:55
onur
Wenn ich das auch noch einbaue, kommt dann wohl die NÄCHSTE Änderung.
Du musst nicht den ganzen Arm nehmen, wenn man dir den kleinen Finger gibt.
Trotzdem:
https://www.herber.de/bbs/user/137910.xlsm
Anzeige
AW: Zellinhalte nach Fehlern überprüfen?
31.05.2020 20:53:30
Sergej
Hallo Onur,
funktioniert perfekt. Besten Dank!
Natürlich hätte ich noch eine Frage, aber das lasse ich lieber ;-)
Beste Grüße,
Sergej
AW: Zellinhalte nach Fehlern überprüfen?
31.05.2020 20:54:10
onur
Stelle sie ruhig.
AW: Zellinhalte nach Fehlern überprüfen?
31.05.2020 21:21:56
Sergej
Ich brauche noch zwei separate Makros, die folgendes erledigen können:
Makro 1: Wenn die Zelle in Spalte B in ROT dargestellt, dann soll in Spalte A nach Zellinhalt zwischen [GUID]....@ gesucht werden und dessen Inhalt soll in eine neue Tabelle "Zusammenfassung_GUID" ab Zelle A2 nach unten (untereinander) aufgeführt werden.
Im Beispiel wäre das Ergebnis in der Tabelle "Zusammenfassung_GUID":
6455392933075620074
6668456314920617009
Makro 2: Wenn die Zelle in Spalte B in ROT dargestellt, dann soll in Spalte A und dann eine Zeile höher nach Text der mit ID: begint gesucht werden. Wenn der Text vorhanden ist, dann davon reine Nummer bis nächstem leeren Zeichen übernehmen und in eine neue Tabelle "Zusammenfassung_ID" ab Zelle A2 nach unten (untereinander) aufführen.
Manchmal steht die ID-Nummer, manchmal auch gar kein ID Zeile.
Es gibt auch Fall, wo dies steht: ID:10551492 Fehler Key korrupt B[KUN_08, Position = 1007
Sprich Nummer und danach noch eine Beschreibung...
Im Beispiel wäre das Ergebnis in der Tabelle "Zusammenfassung_ID":
10596251
10596475
10551492
Anzeige
AW: Zellinhalte nach Fehlern überprüfen?
31.05.2020 21:24:14
onur
Vergiss es - das was ich schon für dich erstellt habe, war schon zu viel für einen kleinen kostenlosen Gefallen.
Hier noch eine VBA-Lösung...
31.05.2020 14:30:04
Martin
Hallo Sergej,
bekanntlich führen viele Wege nach Rom. Hier ist mein Lösungsvorschlag:
Sub Start()
Dim rngRowCell As Range
For Each rngRowCell In ActiveSheet.UsedRange.Columns(1).Cells
If InStr(rngRowCell, "@") > 0 Then
Call ControlCell(rngRowCell)
End If
Next
End Sub
Sub ControlCell(rngCell As Range)
Dim arrValue As Variant
Dim i As Integer, j As Integer
Dim iPos As Integer
arrValue = Split(rngCell.Text, "[")
rngCell.Offset(, 1).Interior.ColorIndex = 43
For i = 0 To UBound(arrValue) - 1
If InStr(arrValue(i), "@") = 0 And Left(arrValue(i + 1), 1)  "$" Then
rngCell.Offset(, 1).Interior.ColorIndex = 3
iPos = InStr(rngCell.Text, arrValue(i)) + Len(arrValue(i))
With rngCell.Characters(iPos, Length:=1).Font
.FontStyle = "Fett"
.Size = 16
.ColorIndex = 3
End With
End If
Next
End Sub
Viele Grüße
Martin
Anzeige
AW: Hier noch eine VBA-Lösung...
31.05.2020 19:44:09
Sergej
Hallo Martin,
dein Code funktioniert fast ;-)
Ich habe hier ein Beispiel, wo bestimmte Zeichen nicht richtig farbig dargestellt sind.
Hier ein Beispiel:
Beste Grüße,
Sergej
AW: Hier noch eine VBA-Lösung...
01.06.2020 00:58:21
Martin
Hallo Sergej,
kannst du mir bitte die betreffende(n) Zelle(n) in einer Beispieldatei hochladen, damit ich das Problem besser analysieren kann?
Viele Grüße
Martin
AW: Hier noch eine VBA-Lösung...
01.06.2020 02:36:35
Martin
Hallo Sergej,
bitte teste mal, ob es so fehlerfrei durchläuft:
Sub Start()
Dim rngRowCell As Range
For Each rngRowCell In ActiveSheet.UsedRange.Columns(1).Cells
If InStr(rngRowCell, "@") > 0 Then
Call ControlCell(rngRowCell)
End If
Next
End Sub
Sub ControlCell(rngCell As Range)
Dim arrValue As Variant
Dim i As Integer, j As Integer
Dim strLen As String
arrValue = Split(rngCell.Text, "[")
rngCell.Offset(, 1).Interior.ColorIndex = 43
For i = 0 To UBound(arrValue) - 1
If InStr(arrValue(i), "@") = 0 And Left(arrValue(i + 1), 1)  "$" Then
rngCell.Offset(, 1).Interior.ColorIndex = 3
strLen = ""
For j = 0 To i
strLen = strLen & arrValue(j)
Next
With rngCell.Characters(Len(strLen) + j, 1).Font
.FontStyle = "Fett"
.Size = 16
.ColorIndex = 3
End With
End If
Next
End Sub
Viele Grüße
Martin
Anzeige
AW: Hier noch eine VBA-Lösung...
01.06.2020 09:41:19
Sergej
Einen wunderschönen guten Morgen Martin,
jetzt funktioniert auch dein Code perfekt. Inzwischen gab es eine Ergänzung ;-)
Der Inhalt zwischen [GUID]........ und @-Zeichen muss in BLAU mit Schriftgröße 16 und fett fargestellt werden. Es betrifft alle Zellinhalte in Spalte A.
Nachher:
Beste Grüße,
Sergej
AW: Hier noch eine VBA-Lösung...
01.06.2020 10:51:30
Martin
Hallo Sergej,
okay, hier der Code mit der neuen Anforderung:
Sub Start()
Dim rngRowCell As Range
For Each rngRowCell In ActiveSheet.UsedRange.Columns(1).Cells
If InStr(rngRowCell, "@") > 0 Then
Call ControlCell(rngRowCell)
Call SetBlue(rngRowCell)
End If
Next
End Sub
Sub ControlCell(rngCell As Range)
Dim arrValue As Variant
Dim i As Integer
Dim strLen As String
arrValue = Split(rngCell.Text, "[")
rngCell.Offset(, 1).Interior.ColorIndex = 43
For i = 0 To UBound(arrValue) - 1
strLen = strLen & arrValue(i)
If InStr(arrValue(i), "@") = 0 And Left(arrValue(i + 1), 1)  "$" Then
rngCell.Offset(, 1).Interior.ColorIndex = 3
With rngCell.Characters(Len(strLen) + i + 1, 1).Font
.FontStyle = "Fett"
.Size = 16
.ColorIndex = 3
End With
End If
Next
End Sub
Sub SetBlue(rngCell As Range)
Dim arrValue As Variant
Dim i As Integer
Dim strLen As String
arrValue = Split(rngCell.Text, "[GUID]")
strLen = arrValue(0)
For i = 1 To UBound(arrValue)
If InStr(arrValue(i), "@") > 0 Then
With rngCell.Characters(Len(strLen) + (i * 7), InStr(arrValue(i), "@") - 1).Font
.FontStyle = "Fett"
.Size = 16
.ColorIndex = 41
End With
End If
strLen = strLen & arrValue(i)
Next
End Sub
Viele Grüße
Martin
Anzeige
AW: Hier noch eine VBA-Lösung...
01.06.2020 11:10:49
Sergej
Hallo Martin,
perfekt! Vielen herzlichen Dank!
Ich brauche noch zwei separate Makros, die folgendes erledigen können. Ich hoffe du kannst hierbei bitte helfen ;-)
Makro 1: Wenn die Zelle in Spalte B in ROT dargestellt ist, dann soll in Spalte A nach Zellinhalt zwischen [GUID]....@ gesucht werden und dessen Inhalt soll in eine neue Tabelle "Zusammenfassung_GUID" ab Zelle A2 nach unten (untereinander) aufgeführt werden.
Im Beispiel wäre das Ergebnis in der Tabelle "Zusammenfassung_GUID":
6455392933075620074
6668456314920617009
Makro 2: Wenn die Zelle in Spalte B in ROT dargestellt, dann soll in Spalte A und dann eine Zeile höher nach Text der mit ID: beginnt gesucht werden. Wenn der Text vorhanden ist, dann davon reine Nummer bis nächstem leeren Zeichen übernehmen und in eine neue Tabelle "Zusammenfassung_ID" ab Zelle A2 nach unten (untereinander) aufführen.
Manchmal steht die ID-Nummer, manchmal auch gar kein ID Zeile.
Es gibt auch Fall, wo dies steht: ID:10551492 Fehler Key korrupt B[KUN_08, Position = 1007
Sprich Nummer und danach noch eine Beschreibung...
Im Beispiel wäre das Ergebnis in der Tabelle "Zusammenfassung_ID":
10596251
10596475
10551492
Beste Grüße,
Sergej
Anzeige
Makro1
01.06.2020 13:47:38
Martin
Hallo Sergej,
das grenzt jetzt eigentlich schon an Auftragsprogrammierung. Hier vorab Makro1:
Sub CollectGUIDs()
Dim rngRowCell As Range
Dim dicGUID As Object
Set dicGUID = CreateObject("Scripting.Dictionary")
With dicGUID
For Each rngRowCell In ActiveSheet.UsedRange.Columns(2).Cells
If rngRowCell.Interior.ColorIndex = 3 Then
.Add .Count + 1, GetGUID(rngRowCell.Offset(, -1))
End If
Next
End With
With Sheets("Zusammenfassung_GUID").Range("A2").Resize(dicGUID.Count, 1)
.NumberFormat = "@"
.Value = Application.Transpose(dicGUID.Items)
End With
End Sub
Function GetGUID(rngCell As Range) As String
Dim arrValue As Variant
Dim i As Integer
Dim strLen As String
arrValue = Split(rngCell.Text, "[GUID]")
strLen = arrValue(0)
For i = 1 To UBound(arrValue)
If InStr(arrValue(i), "@") > 0 Then
GetGUID = Mid(rngCell.Text, Len(strLen) + (i * 7), InStr(arrValue(i), "@") - 1)
End If
strLen = strLen & arrValue(i)
Next
End Function
Das Tabellenblatt Zusammenfassung_GUID legst du bitte selbst an.
Viele Grüße
Martin
Anzeige
Makro2
01.06.2020 14:08:55
Martin
Hallo Sergej,
und hier das gewünschte zweite Makro:
Sub CollectIDs()
Dim rngRowCell As Range
Dim dicID As Object
Dim strID As String
Dim iPos As Integer
Set dicID = CreateObject("Scripting.Dictionary")
For Each rngRowCell In ActiveSheet.UsedRange.Columns(2).Cells
If rngRowCell.Interior.ColorIndex = 3 Then
strID = rngRowCell.Offset(-1, -1)
iPos = InStr(strID, "ID:")
If iPos > 0 Then
strID = Mid(strID, iPos + 3)
iPos = InStr(strID, " ")
If iPos > 0 Then
strID = Left(strID, iPos - 1)
End If
dicID.Add dicID.Count + 1, strID
End If
End If
Next
With Sheets("Zusammenfassung_GUID").Range("A2").Resize(dicID.Count, 1)
.NumberFormat = "@"
.Value = Application.Transpose(dicID.Items)
End With
End Sub
Viele Grüße
Martin
Name der Tabelle anpassen...
01.06.2020 14:16:40
Martin
Hallo Sergey,
im zweiten Makro CollectIDs müsstest du noch den Tabellennamen anpassen, da ich versehentlich Zusammenfassung_GUID beibehalten hatte:
With Sheets("Zusammenfassung_ID").Range("A2").Resize(dicID.Count, 1)
Viele Grüße
Martin
AW: Makro2
01.06.2020 14:19:05
Sergej
Hallo Martin,
funktioniert wie immer perfekt - vielen herzlichen Dank!
Beste Grüße,
Sergej

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige