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
Antworten 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
Antworten 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
Antworten 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
Antworten 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
Antworten 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
Antworten 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
Antworten 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
Antworten 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
Antworten Top
#40
Hi Memo,

so!

LG
Alexandra


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


Gehe zu:


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