Bir makro kodunu kısaltmak

S

siar

Katılım
11 Mart 2005
Mesajlar
201
Excel Vers. ve Dili
2007 TR
Aşağıdaki gibi bir kaç kodu kısaltmak istiyorum. Bunun bir yolu var mıdır acaba?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Target.Cells.Count > 1 Then Exit Sub

Set rng = Application.Intersect(Target, Me.Range("a:z"))
If rng Is Nothing Then Exit Sub
With Target
If Intersect(Target, [A:z]) Is Nothing Then Exit Sub
Satır = "A" & Target.Row & ":z" & Target.Row
Select Case Target
Case "1": Range(Satır).Interior.ColorIndex = 2
Case "2": Range(Satır).Interior.ColorIndex = 28
Case "3": Range(Satır).Interior.ColorIndex = 2
Case "4": Range(Satır).Interior.ColorIndex = 28
Case "5": Range(Satır).Interior.ColorIndex = 2
Case "6": Range(Satır).Interior.ColorIndex = 28
Case "7": Range(Satır).Interior.ColorIndex = 2
Case "8": Range(Satır).Interior.ColorIndex = 28
Case "9": Range(Satır).Interior.ColorIndex = 2
Case "10": Range(Satır).Interior.ColorIndex = 28
Case "11": Range(Satır).Interior.ColorIndex = 2
Case "12": Range(Satır).Interior.ColorIndex = 28
Case "13": Range(Satır).Interior.ColorIndex = 2
Case "14": Range(Satır).Interior.ColorIndex = 28
Case "15": Range(Satır).Interior.ColorIndex = 2
Case "16": Range(Satır).Interior.ColorIndex = 28
Case "17": Range(Satır).Interior.ColorIndex = 2
Case "18": Range(Satır).Interior.ColorIndex = 28
Case "19": Range(Satır).Interior.ColorIndex = 2
Case "20": Range(Satır).Interior.ColorIndex = 28
Case "21": Range(Satır).Interior.ColorIndex = 2
Case "22": Range(Satır).Interior.ColorIndex = 28
Case "23": Range(Satır).Interior.ColorIndex = 2
Case "24": Range(Satır).Interior.ColorIndex = 28
Case "25": Range(Satır).Interior.ColorIndex = 2
Case "26": Range(Satır).Interior.ColorIndex = 28
Case "27": Range(Satır).Interior.ColorIndex = 2
Case "28": Range(Satır).Interior.ColorIndex = 28
Case "29": Range(Satır).Interior.ColorIndex = 2
Case "30": Range(Satır).Interior.ColorIndex = 28
Case "31": Range(Satır).Interior.ColorIndex = 2
Case "32": Range(Satır).Interior.ColorIndex = 28
Case "33": Range(Satır).Interior.ColorIndex = 2
Case "34": Range(Satır).Interior.ColorIndex = 28
Case "35": Range(Satır).Interior.ColorIndex = 2
Case "36": Range(Satır).Interior.ColorIndex = 28
Case "37": Range(Satır).Interior.ColorIndex = 2
Case "38": Range(Satır).Interior.ColorIndex = 28
Case "39": Range(Satır).Interior.ColorIndex = 2
Case "40": Range(Satır).Interior.ColorIndex = 28
Case "41": Range(Satır).Interior.ColorIndex = 2
Case "42": Range(Satır).Interior.ColorIndex = 28
Case "43": Range(Satır).Interior.ColorIndex = 2
Case "44": Range(Satır).Interior.ColorIndex = 28
Case "45": Range(Satır).Interior.ColorIndex = 2
Case "46": Range(Satır).Interior.ColorIndex = 28
Case "47": Range(Satır).Interior.ColorIndex = 2
Case "48": Range(Satır).Interior.ColorIndex = 28
Case "49": Range(Satır).Interior.ColorIndex = 2
Case "50": Range(Satır).Interior.ColorIndex = 28
Case "51": Range(Satır).Interior.ColorIndex = 2
Case "52": Range(Satır).Interior.ColorIndex = 28
Case "53": Range(Satır).Interior.ColorIndex = 2
Case "54": Range(Satır).Interior.ColorIndex = 28
Case "55": Range(Satır).Interior.ColorIndex = 2
Case "56": Range(Satır).Interior.ColorIndex = 28
Case "57": Range(Satır).Interior.ColorIndex = 2
Case "58": Range(Satır).Interior.ColorIndex = 28
Case "59": Range(Satır).Interior.ColorIndex = 2
Case "60": Range(Satır).Interior.ColorIndex = 28
Case "61": Range(Satır).Interior.ColorIndex = 2
Case "62": Range(Satır).Interior.ColorIndex = 28
Case "63": Range(Satır).Interior.ColorIndex = 2
Case "64": Range(Satır).Interior.ColorIndex = 28
Case "65": Range(Satır).Interior.ColorIndex = 2
Case "66": Range(Satır).Interior.ColorIndex = 28
Case "67": Range(Satır).Interior.ColorIndex = 2
Case "68": Range(Satır).Interior.ColorIndex = 28
Case "69": Range(Satır).Interior.ColorIndex = 2
Case "70": Range(Satır).Interior.ColorIndex = 28
Case "71": Range(Satır).Interior.ColorIndex = 2
Case "72": Range(Satır).Interior.ColorIndex = 28
Case "73": Range(Satır).Interior.ColorIndex = 2
Case "74": Range(Satır).Interior.ColorIndex = 28
Case "75": Range(Satır).Interior.ColorIndex = 2
Case "76": Range(Satır).Interior.ColorIndex = 28
Case "77": Range(Satır).Interior.ColorIndex = 2
Case "78": Range(Satır).Interior.ColorIndex = 28
Case "79": Range(Satır).Interior.ColorIndex = 2
Case "80": Range(Satır).Interior.ColorIndex = 28
Case "81": Range(Satır).Interior.ColorIndex = 2
Case "82": Range(Satır).Interior.ColorIndex = 28
Case "83": Range(Satır).Interior.ColorIndex = 2
Case "84": Range(Satır).Interior.ColorIndex = 28
Case "85": Range(Satır).Interior.ColorIndex = 2
Case "86": Range(Satır).Interior.ColorIndex = 28
Case "87": Range(Satır).Interior.ColorIndex = 2
Case "88": Range(Satır).Interior.ColorIndex = 28
Case "89": Range(Satır).Interior.ColorIndex = 2
Case "90": Range(Satır).Interior.ColorIndex = 28
Case "91": Range(Satır).Interior.ColorIndex = 2
Case "92": Range(Satır).Interior.ColorIndex = 28
Case "93": Range(Satır).Interior.ColorIndex = 2
Case "94": Range(Satır).Interior.ColorIndex = 28
Case "95": Range(Satır).Interior.ColorIndex = 2
Case "96": Range(Satır).Interior.ColorIndex = 28
Case "97": Range(Satır).Interior.ColorIndex = 2
Case "98": Range(Satır).Interior.ColorIndex = 28
Case "99": Range(Satır).Interior.ColorIndex = 2
Case "100": Range(Satır).Interior.ColorIndex = 28
Case Else
Range(Satır).Interior.ColorIndex = xlNone
End Select
End With


End Sub
 
L

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,058
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Aşağıdaki şekilde deneyin.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, [A:z]) Is Nothing Then Exit Sub
Satır = "A" & Target.Row & ":z" & Target.Row
Range(Satır).Interior.ColorIndex = xlNone
If Target > 100 Then Exit Sub
If Target Mod 2 = 0 Then
Range(Satır).Interior.ColorIndex = 28
Else
Range(Satır).Interior.ColorIndex = 2
End If
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst