Aktuell kann es Probleme bei der Anmeldung mit dem Chrome oder Edge Browser geben. Ihr müsstet in die Einstellungen des Browsers gehen und Cache, Cookies und sofern vorhanden, gespeicherte Passwörter vom CEF löschen oder alternativ auf einen anderen Browser ausweichen. Ursache sind vermutlich kürzliche Browserupdates. x

VBA: Vergleichen mit mehreren Bedingungen
#31
Angel


Angehängte Dateien
.xlsm   Select_Case_Memo_V3.xlsm (Größe: 28,4 KB / Downloads: 19)
[-] Folgende(r) 1 Nutzer sagt Danke an cysu11 für diesen Beitrag:
  • Memo
Top
#32
Super Danke. Funktioniert...aber warum find ich den Fehler nicht?
Habe alten und neuen Code verglichen..nicht fündig geworden.

Hast du überhaupt ein Fehler finden können?

Danke nochmals und sorry für die erneute Störung.

Gruß
Memo
Top
#33
Hi Memo,

wenn ich den Fehler nicht gefunden hätte, dann würde es ja jetzt nicht funktionieren, oder?  :)

If .Cells(raZelle.Row, raZielzelle.Column) < daDatum And _
                   .Cells(raZelle.Row, raZielzelle.Column) >= Date Then
                       raZelle.EntireRow.Interior.ColorIndex = 6
                   Else
                   If .Cells(raZelle.Row, raZielzelle.Column + 2) < daDatum And _
                   .Cells(raZelle.Row, raZielzelle.Column + 2) >= Date Then
                       raZelle.EntireRow.Interior.ColorIndex = 6
                   End If
                   End If

LG
Alexandra
[-] Folgende(r) 1 Nutzer sagt Danke an cysu11 für diesen Beitrag:
  • Memo
Top
#34
Hi,

ich hirni habe versehentlich den alten code kopiert, deshalb nicht gefunden :16: `

Aber herzlichen Dank für deine Hilfsbereitschaft und vor allem für die Geduld.

Grüße
Memo
Top
#35
So läuft's


Code:
Sub M_snb()
   sn = Tabelle1.Cells(4, 1).CurrentRegion
   
   For j = 1 To UBound(sn)
      y = sn(j, 78 + 2 * Right(sn(j, 13), 1))
      If y > Date And y <= DateAdd("m", 1, Date) Then c00 = c00 & " " & j
   Next
   
   If c00 <> "" Then
     st = Split(Trim(c00))
     Tabelle2.Cells(2, 1).Resize(UBound(st) + 1, UBound(sn, 2)) = Application.Index(sn, Application.Transpose(st), [transpose(row(1:105))])
   End If
End Sub

Man braucht gar keine Markierung oder Farben.
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Top
#36
Und zur Hilfe kommt advancedfilter.
Schau mal:


Angehängte Dateien
.xlsb   __filter.xlsb (Größe: 21,16 KB / Downloads: 6)
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Top
#37
Hi Sn,

habe dein Code eingefügt und getestet. Da tut sich nichts.

Habe es ehrlich gesagt auch nicht so ganz verstanden, warum ist der denn so kurz gehalten der Code?

Und was tut er anstatt die Zeile gelb zu färben, sprich was ist der Erkennungszeichen ?

VG
Memo
Top
#38
Hi Sn,


warum bekomme ich denn eine Fehlermeldung wenn ich die selbe lange SUMME Formel in meine Datei kopiere? Habe leider die Fehlerquelle nicht gefunden.

Fehlermeldung:

Der eingegebene Name ist ungültig und markiert das:   [@[IL2

In der Formel sind jede Menge leerzeichen gewesen, an das lags aber nicht.

VG
Memo
Top
#39
Hi Alexandra,

klopf mal wieder an deine Tür :).

Kannst du mir bitte verraten, wie ich bei "..." die Anzahl der aus der funktionierenden VBA gefärbten Zeilen ausgeben?

  
Sub Filtern()
Dim raZelle As Range, raZielzelle As Range
Dim daDatum As Date, loLetzte As Long
Dim loLetzteZ As Long
 
daDatum = DateSerial(Year(Date), Month(Date) + 1, Day(Date))
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
    loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
    For Each raZelle In .Range("M4:M" & loLetzte).SpecialCells(xlCellTypeConstants)
        Select Case raZelle.Value
            Case "IL2", "IL3", "IL4", "IL5"
                Set raZielzelle = .Range("2:2").Find(what:=raZelle.Value, _
                LookIn:=xlValues, lookat:=xlPart)
                If Not raZielzelle Is Nothing Then
                    If .Cells(raZelle.Row, raZielzelle.Column) < daDatum And _
                    .Cells(raZelle.Row, raZielzelle.Column) >= Date Then
                        raZelle.EntireRow.Interior.ColorIndex = 6
                    Else
                    If .Cells(raZelle.Row, raZielzelle.Column + 2) < daDatum Then
                        raZelle.EntireRow.Interior.ColorIndex = 6
                    End If
                    End If
                End If
            Case Else
        End Select
    Next raZelle
    .Columns("C:P").Hidden = False
    .Range("$A$3:$Z$" & loLetzte).AutoFilter Field:=1, Criteria1:=RGB(255, 255, 0), _
    Operator:=xlFilterCellColor
    With .AutoFilter.Range
        .Resize(.Rows.Count - 1).Offset(1, 0).Copy
    End With
    With Worksheets("Tabelle2")
        loLetzteZ = .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
        If .Cells(1, 1) = "" Then loLetzteZ = 1
        .Cells(loLetzteZ, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End With
    .Columns("C:P").Hidden = False
    .AutoFilter.ShowAllData
    MsgBox (MsgBox("Es wurde insgesamt ... Zeilen ausgewertet worden.", vbOKOnly + vbInformation, "Memo"))
End With
Application.CutCopyMode = False
Set raZielzelle = Nothing
End Sub


VG
Memo
Top
#40
Hi Memo,

so!

LG
Alexandra


Angehängte Dateien
.xlsm   Select_Case_Memo_V3.xlsm (Größe: 29,4 KB / Downloads: 11)
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste