sukruyilmaz1
Altın Üye
- Katılım
- 19 Haziran 2008
- Mesajlar
- 301
- Excel Vers. ve Dili
- Office 365
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim X As Long, Y As Integer, Bul As Range
Application.ScreenUpdating = False
For X = 3 To 18 Step 3
For Y = 4 To 44 Step 4
Set Bul = Range("A28:A35").Find(Cells(X, Y), , , xlWhole)
If Not Bul Is Nothing Then
Cells(X, Y - 1).Resize(2, 2).Interior.Color = Bul.Offset(, 2).Interior.Color
Else
Cells(X, Y - 1).Resize(2, 2).Interior.Color = xlNone
End If
Next
Next
Set Bul = Nothing
Application.ScreenUpdating = True
End Sub
Merhaba,
Sayfanızın kod bölümüne uygulayınız.
Bir hücreye tıkladığınızda işlem gerçekleşecektir.
C++:Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim X As Long, Y As Integer, Bul As Range Application.ScreenUpdating = False For X = 3 To 18 Step 3 For Y = 4 To 44 Step 4 Set Bul = Range("A28:A35").Find(Cells(X, Y), , , xlWhole) If Not Bul Is Nothing Then Cells(X, Y - 1).Resize(2, 2).Interior.Color = Bul.Offset(, 2).Interior.Color Else Cells(X, Y - 1).Resize(2, 2).Interior.Color = xlNone End If Next Next Set Bul = Nothing Application.ScreenUpdating = True End Sub