• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

makro kod kısaltma

Katılım
12 Kasım 2011
Mesajlar
54
Excel Vers. ve Dili
excell 2010 türkçe
merhaba üstadlarım;

makroda kaydedilen bir kodum var. bu kodu nasıl kısaltabilirim.

saygılarımla.

Kod:
Sub sip_renklendir()
Sheets("SIPARISLER").Select
        Columns("A:P").Select
        With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
  For i = 6 To Range("G10000").End(3).Row - 1
      If Cells(i, "G") - [a1] <= 0 And Cells(i, "b") <> "MURATBEY GIDA SAN VE TIC AS ISTANBUL" Then
            tanım = "G" & i
            Range(tanım).Select
                With Selection.Interior
                .Pattern = xlPatternLinearGradient
                .Gradient.Degree = 90
                .Gradient.ColorStops.Clear
                End With
                With Selection.Interior.Gradient.ColorStops.Add(0)
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
                End With
                With Selection.Interior.Gradient.ColorStops.Add(0.5)
                .Color = 5287936
                .TintAndShade = 0
                End With
                With Selection.Interior.Gradient.ColorStops.Add(1)
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
                End With
                
              ElseIf Cells(i, "G") - [a1] <= 3 And Cells(i, "b") <> "MURATBEY GIDA SAN VE TIC AS ISTANBUL" Then
                tanım = "G" & i
                Range(tanım).Select
                With Selection.Interior
                .Pattern = xlPatternLinearGradient
                .Gradient.Degree = 90
                .Gradient.ColorStops.Clear
                End With
                With Selection.Interior.Gradient.ColorStops.Add(0)
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
                End With
                With Selection.Interior.Gradient.ColorStops.Add(0.5)
                .Color = 5296274
                .TintAndShade = 0
                End With
                With Selection.Interior.Gradient.ColorStops.Add(1)
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
                End With
                
                
                ElseIf Cells(i, "G") - [a1] <= 6 And Cells(i, "b") <> "MURATBEY GIDA SAN VE TIC AS ISTANBUL" Then
                tanım = "G" & i
                Range(tanım).Select
                With Selection.Interior
                .Pattern = xlPatternLinearGradient
                .Gradient.Degree = 90
                .Gradient.ColorStops.Clear
                End With
                With Selection.Interior.Gradient.ColorStops.Add(0)
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
                End With
                With Selection.Interior.Gradient.ColorStops.Add(0.5)
                .Color = 65535
                .TintAndShade = 0
                End With
                With Selection.Interior.Gradient.ColorStops.Add(1)
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
                End With
                
                
                ElseIf Cells(i, "G") - [a1] > 6 And Cells(i, "b") <> "MURATBEY GIDA SAN VE TIC AS ISTANBUL" Then
                tanım = "G" & i
                Range(tanım).Select
                With Selection.Interior
                .Pattern = xlPatternLinearGradient
                .Gradient.Degree = 90
                .Gradient.ColorStops.Clear
                End With
                With Selection.Interior.Gradient.ColorStops.Add(0)
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
                End With
                With Selection.Interior.Gradient.ColorStops.Add(0.5)
                .Color = 255
                .TintAndShade = 0
                End With
                With Selection.Interior.Gradient.ColorStops.Add(1)
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
                End With
        End If
    Next i
    End Sub
 
Geri
Üst