Hallo liebe VBA Profis! Brauche dringend eure Hilfe, da ich in der VBA-Sprache mich noch gar nicht zurecht finde. Ich müsste folgenden Befehl schreiben: Ich habe zwei Tabellenblätter. Wenn im Bereich D6:L30 des Tabellenblatts „Kritische Fälle“ die gleiche AWB-Nummer auftaucht wie im Tabellenblatt „Bearbeitet“, dann färbe die AWB-Nummer in „Kritische Fälle“ rot.
Ich danke euch jetzt schon mal!!
Lg,
Andrea
Hallo Andrea
Denn Code wirst sicher schon haben.
Wennst noch hilfe brauchst, melde dich.
Gruß Fred
Werte vergleichen kannst Du beispielsweise mit dem befehl:
If tabelle1.cells(1,2)=Tabelle2.cells(3.4) then
…
else
…
end if
cells(1,2) wäre dann die Zelle B1
Cells(3,4) ist dann (3,D) also D3
Du kannst die zahlenwerte mittels variabeln gestalten.
dim r as long, c as long
c=1
'Forschleife, durchsucht alle ersten 100 Zeile in der Spalte 1 –> A.
for r= 1 to 100
'Vergleichsabfragde
If tabelle1.cells(r,c)=Tabelle2.cells(r.c) then
'Zelle Markieren
tabelle1.cells(r,c).select
'Farbe rot hinterlegen
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
end if
next r
Grüsse Sebastian
Hallo Andrea,
die entsprächende Färbung im Blatt Kritische Fälle kannst du auch mit einer bedingten Formatierung erreichen, zumindest in Excel 2010.
bedingte Formatierung für Bereich D6:L30
mit Formel als Bedingung:
=ZÄHLENWENN(Bearbeitet!$A:blush:A;D6)\>0
Den Eingabebeich (hier Spalten $A:blush:A) für die AWB-Nummern entsprechend anpassen
Eine Makrolösung könnte wie folgt aussehen. Sobald im Eingabebereich eine Änderung erfolgt wird die Färbung für die kritischen AWB geprüft und aktualisiert.
Gruß
Franz
'Makros im VBA-Editor unter Modul von Tabellenblatt "Bearbeitet"
Private Sub Worksheet\_Change(ByVal Target As Range)
Dim rngCheck As Range
'Eingabebereich im Blatt "Bearbeitet" für die AWB-Werte
'hier in Spalte A ab Zeile 2 abwärts
With Me
Set rngCheck = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)) 'Berechnung des \_
Bereichs ggf. anpassen oder fest vorgeben
End With
'prüfen, ob geänderte Zelle(n) im Eingabebereich
If Not Application.Intersect(Target, rngCheck) Is Nothing Then
Call FaerbeKritischeAWB(Bereich:=rngCheck)
End If
End Sub
Sub FaerbeKritischeAWB(Bereich As Range)
Dim wksCheck As Worksheet, rngZelle As Range, rngAWB As Range
Dim StatusCalc As Long
'Makrobremsen lösen
With Application
.EnableEvents = False
StatusCalc = .Application.Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Set wksCheck = Worksheets("Kritische Fälle")
With wksCheck.Range("D6:L30")
.Interior.ColorIndex = xlColorIndexNone
For Each rngZelle In Bereich.Cells
If rngZelle "" Then
Set rngAWB = .Find(What:=rngZelle.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not rngAWB Is Nothing Then
rngAWB.Interior.Color = RGB(0, 255, 255) 'hellblau
End If
End If
Next rngZelle
End With
'Makrobremsen zurücksetzen
With Application
.EnableEvents = True
.Calculation = StatusCalc
.ScreenUpdating = True
End With
Set wksCheck = Nothing: Set rngAWB = Nothing: Set rngZelle = Nothing
End Sub
Grüezi Andrea
Das müsste mit der Bedingten Formatierung eigentlich auch ohne VBA-Programmierung machbar sein.
Welche Excel-Version verwendest Du denn?
Mit freundlichen Grüssen
Thomas Ramel
Habe es gerade erst gelesen, müßte man aber mit der bedingten Formatierung machen können.
Carsten
Sub Makro1()
Sheets(„Kritische Fälle“).Select
For i = 6 To 30
For j = 4 To 12
Such = „“
Wert = Cells(i, j).Value
Select Case Wert
Case Is = „“
GoTo weiter
Case Is „“
Sheets(„Bearbeitet“).Select
On Error Resume Next
Such = Cells.Find(What:=Wert, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
If Such = True Then
Sheets(„Kritische Fälle“).Select
Cells(i, j).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
End If
End Select
weiter:
Sheets(„Kritische Fälle“).Select
Next j
Next i
End Sub
Gruß,
Ptonka