Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
332to336
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
332to336
332to336
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Farbe ändern aufgrund If Bedingung

Farbe ändern aufgrund If Bedingung
03.11.2003 13:09:37
Maggus
Hallo zusammen,

ich stehe irgendwie auf dem Schlauch und benötige etwas Rat. Bisher habe ich ein Makro das mir aus zwei Tabellenblattern einen Nr. Abgleich fährt und dann bei übereinstimmung (xlPart) eine andere Nummer kopiert.

Mein Problem: Die Nr. über die der Abgleich läuft sind nicht immer exakt gleich z.B. soll 23758 = 23758* sein, doch 23758** sollte nicht ohne weiteres akzeptiert werden. Daher möchte ich eine IF Bedingung einbauen, sobald in dem gefundenen Wert zwei oder mehr * auftauchen soll er mir die neue Zeile farbig markieren, und da tappe ich im dunkel. Wie kann ich das realisieren.

Gruß
Markus

Sheets(1).Activate
lastrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lastrow
Wert = Cells(i, 1).Value
With Sheets(2).Columns(3)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlPart)
If Not C Is Nothing Then
MyCell = "00000" + C(1, -1)

Cells(i, 4) = MyCell
End If
End With
Next i

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Farbe ändern aufgrund If Bedingung
03.11.2003 14:04:42
Mac4
Hi,

so kannst Du bspw. für die Zelle A1 abfragen, ob sich im Text mehr als 2 * befinden, wenn ja, wird die Zelle rot gefärbt:


Sub test()
If Len([A1]) - Len(Application.WorksheetFunction.Substitute([A1], "*", "")) >= 2 Then
[A1].Interior.ColorIndex = 3
End If
End Sub


Marc
AW: Farbe ändern aufgrund If Bedingung
03.11.2003 15:06:29
Maggus
Hallo Marc,

vielen Dank ich habe es jetzt für die ganze reihe übernommen.


Sub Nr_übertragen()
' Nr_übertragen() Makro
Sheets(1).Activate
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow
Wert = Cells(i, 1).Value
With Sheets(2).Columns(3)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlPart)
If Not C Is Nothing Then
MyCell = "00000" + C(1, -1) 'sorgt für die Vornullen
If Len(C) - Len(Application.WorksheetFunction.Substitute([C], "*", "")) >= 2 Then
Rows(i).Interior.ColorIndex = 3
MsgBox "Es wurde eine Nr doppelt gefunden und rot markiert."
End If
Cells(i, 4) = MyCell
End If
End With
Next i
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige