VBA-Forum - Das Forum zu Microsoft VBA

VBA Excel VBA Word VBA Access VBA VBScript VB C# Objective-C C++ SQL JAVA VBA (English) Jobs Übersicht

Thema	Datum	Von Nutzer	Rating	Antwort
Code kürzen Schleife	10.10.2019 18:01:05	Harald
Code kürzen Schleife	10.10.2019 18:12:06	Mase
Code kürzen Schleife	10.10.2019 22:40:24	xlKing

Ansicht des Beitrags:

Von:
Harald

Datum:
10.10.2019 18:01:05

Views:
958

Rating:

Antwort:

Thema:
Code kürzen Schleife

Hallo

Habe folgenden Code wo ich 2 Probleme habe:

er steht in einem Tabellenblatt und soll auch nur dort Wirkung zeigen.

1.) Was kann ich statt With ActiveSheet schreiben ich meine ich bräuchte einen Ausdruck für With Sheet indem du stehst.

2.) Desweiteren wollte ich fragen wie ich nachfolgenden Code kürzen Kann. Er müsste eine zusätzliche Schleife für die Farbwerte erhalten anstelle dass ich 30x das selbe schreibe.

With ActiveSheet
Farbwerte = 261
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-248).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

    With ActiveSheet
Farbwerte = 262
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-241).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

     With ActiveSheet
Farbwerte = 263
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-234).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

     With ActiveSheet
Farbwerte = 264
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-227).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 265
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-220).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 266
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-213).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 267
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-206).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 268
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-199).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 269
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-192).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 270
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-185).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 271
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-178).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 272
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-171).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 273
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-164).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 274
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-157).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 275
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-150).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 276
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-143).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 277
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-136).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 278
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-129).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 279
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-122).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 280
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-115).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 281

    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-108).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 282
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-101).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 283
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-94).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 284
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-87).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 285
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-80).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 286
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-73).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 287
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-66).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 288
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-59).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 289
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-52).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

With ActiveSheet
Farbwerte = 290
    'Schleife von Spalte C = AG
    For i = 3 To 34
        'Pr?fung ob Zelle nicht leer und ob der Zellwert numerisch ist
        If .Cells(Farbwerte, i) <> "" And IsNumeric(.Cells(Farbwerte, i)) Then
            'wenn ja, Zellwert als Farbwrt f?r Zelle oberhalb ?bernehmen
            .Cells(Farbwerte, i).Offset(-45).Interior.Color = .Cells(Farbwerte, i)
        End If
    Next i
End With

Ihre Antwort

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema:		Name:		Email:

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema	Datum	Von Nutzer	Rating	Antwort
Code kürzen Schleife	10.10.2019 18:01:05	Harald
Code kürzen Schleife	10.10.2019 18:12:06	Mase
Code kürzen Schleife	10.10.2019 22:40:24	xlKing