• DİKKAT

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

Üzerine Çift Tıklayınca rengi değişen hücre

I

ismail-34

Katılım
9 Ekim 2021
Mesajlar
343
Excel Vers. ve Dili
excell 2013
Excel web ailesine selamlar saygılar..

Benim sorum J3:J100 arasındaki herhangi bir hücreye çift tıkladığımda rengi yeşile dönsün ancak tekrar çift tıkladığımda
dolgu renginin kalkmasını istiyorum.Yardımcı olursanız sevinirim.

Herkese saygılar sevgiler.İyi Çalışmalar.
 
Umarım işinizi görür.
Kod: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("J3:J100")) Is Nothing Then Exit Sub
If ActiveCell.Interior.ColorIndex = 4 Then
ActiveCell.Interior.ColorIndex = xlNone
ActiveCell.Offset(-1, 0).Select
Else
ActiveCell.Interior.ColorIndex = 4
ActiveCell.Offset(-1, 0).Select
End If
End Sub
 
Saban Sertkaya' Alıntı:
Umarım işinizi görür.
Kod: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("J3:J100")) Is Nothing Then Exit Sub
If ActiveCell.Interior.ColorIndex = 4 Then
ActiveCell.Interior.ColorIndex = xlNone
ActiveCell.Offset(-1, 0).Select
Else
ActiveCell.Interior.ColorIndex = 4
ActiveCell.Offset(-1, 0).Select
End If
End Sub
Genişletmek için tıkla ...
Üstad sizin kod tek başına harika çalışıyor teşekkür ederim. yalnız sayfada çift tıklamalı bir kod daha var o varken hata veriyor..bunları nasıl birleştirebilirim bir bilgin varmı.sizin kodla birleştirdiğim çalışmayan kod aşağıda..

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("C3:C100")) Is Nothing Then Exit Sub
Cancel = True
Target.EntireRow.Interior.Color = IIf(Target.Interior.Color = 65535, xlNone, 65535)
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("J3:J100")) Is Nothing Then Exit Sub
If ActiveCell.Interior.ColorIndex = 4 Then
ActiveCell.Interior.ColorIndex = xlNone
ActiveCell.Offset(-1, 0).Select
Else
ActiveCell.Interior.ColorIndex = 4
ActiveCell.Offset(-1, 0).Select
End If
End Sub
 
Merhaba,
İki kodu If Intersect(Target, Range("J3:J100,C3:C100")) Is Nothing Then Exit Sub şeklinde birleştirebilirsiniz.
 
Aşağıdaki gibi yapabilirsiniz.
Kod: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("C3:C100")) Is Nothing Then
        Cancel = True
        Target.EntireRow.Interior.Color = IIf(Target.Interior.Color = 65535, xlNone, 65535)
    ElseIf Not Intersect(Target, Range("J3:J100")) Is Nothing Then Exit Sub
        If ActiveCell.Interior.ColorIndex = 4 Then
        ActiveCell.Interior.ColorIndex = xlNone
        ActiveCell.Offset(-1, 0).Select
    Else
        ActiveCell.Interior.ColorIndex = 4
        ActiveCell.Offset(-1, 0).Select
    End If
End Sub
 
Muzaffer Ali' Alıntı:
Aşağıdaki gibi yapabilirsiniz.
Kod: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("C3:C100")) Is Nothing Then
        Cancel = True
        Target.EntireRow.Interior.Color = IIf(Target.Interior.Color = 65535, xlNone, 65535)
    ElseIf Not Intersect(Target, Range("J3:J100")) Is Nothing Then Exit Sub
        If ActiveCell.Interior.ColorIndex = 4 Then
        ActiveCell.Interior.ColorIndex = xlNone
        ActiveCell.Offset(-1, 0).Select
    Else
        ActiveCell.Interior.ColorIndex = 4
        ActiveCell.Offset(-1, 0).Select
    End If
End Sub
Genişletmek için tıkla ...
hata veriyor hocam
Muzaffer Ali' Alıntı:
Aşağıdaki gibi yapabilirsiniz.
Kod: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("C3:C100")) Is Nothing Then
        Cancel = True
        Target.EntireRow.Interior.Color = IIf(Target.Interior.Color = 65535, xlNone, 65535)
    ElseIf Not Intersect(Target, Range("J3:J100")) Is Nothing Then Exit Sub
        If ActiveCell.Interior.ColorIndex = 4 Then
        ActiveCell.Interior.ColorIndex = xlNone
        ActiveCell.Offset(-1, 0).Select
    Else
        ActiveCell.Interior.ColorIndex = 4
        ActiveCell.Offset(-1, 0).Select
    End If
End Sub
Genişletmek için tıkla ...
hata verdi hocam.

İndir çift tıklama

Dosyayı indir çift tıklama
dosya.co
 
Dener misiniz?
C++: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("J3:J100,C3:C100")) Is Nothing Then Exit Sub
    Cancel = True
If Target.Column = 3 Then _
    Target.EntireRow.Interior.Color = IIf(Target.Interior.Color = 65535, xlNone, 65535)
If Target.Column = 10 Then
    If ActiveCell.Interior.ColorIndex = 4 Then
        ActiveCell.Interior.ColorIndex = xlNone
        ActiveCell.Offset(-1, 0).Select
    Else
        ActiveCell.Interior.ColorIndex = 4
        ActiveCell.Offset(-1, 0).Select
    End If
End If
End Sub
 
Düzenledim.
Kod: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("C3:C100")) Is Nothing Then
        Cancel = True
        Target.EntireRow.Interior.Color = IIf(Target.Interior.Color = 65535, xlNone, 65535)
    ElseIf Not Intersect(Target, Range("J3:J100")) Is Nothing Then
        If ActiveCell.Interior.ColorIndex = 4 Then
            ActiveCell.Interior.ColorIndex = xlNone
            ActiveCell.Offset(-1, 0).Select
        Else
            ActiveCell.Interior.ColorIndex = 4
            ActiveCell.Offset(-1, 0).Select
        End If
    End If
End Sub
 
dEdE' Alıntı:
Dener misiniz?
C++: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("J3:J100,C3:C100")) Is Nothing Then Exit Sub
    Cancel = True
If Target.Column = 3 Then _
    Target.EntireRow.Interior.Color = IIf(Target.Interior.Color = 65535, xlNone, 65535)
If Target.Column = 10 Then
    If ActiveCell.Interior.ColorIndex = 4 Then
        ActiveCell.Interior.ColorIndex = xlNone
        ActiveCell.Offset(-1, 0).Select
    Else
        ActiveCell.Interior.ColorIndex = 4
        ActiveCell.Offset(-1, 0).Select
    End If
End If
End Sub
Genişletmek için tıkla ...
Dede Hocam siz yaparsınızda olmazmı 2 tıkı bi koda sığdırmışınız helal olsun..Saate gibi Çalışıyor...Hastanızızzz Hocammm
 
Muzaffer Ali' Alıntı:
Düzenledim.
Kod: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("C3:C100")) Is Nothing Then
        Cancel = True
        Target.EntireRow.Interior.Color = IIf(Target.Interior.Color = 65535, xlNone, 65535)
    ElseIf Not Intersect(Target, Range("J3:J100")) Is Nothing Then
        If ActiveCell.Interior.ColorIndex = 4 Then
            ActiveCell.Interior.ColorIndex = xlNone
            ActiveCell.Offset(-1, 0).Select
        Else
            ActiveCell.Interior.ColorIndex = 4
            ActiveCell.Offset(-1, 0).Select
        End If
    End If
End Sub
Genişletmek için tıkla ...
aynen muzaffer hocam deDE hocanınki gibi buda çalışıyor ..teşekkür ederim. saygılar sevgiler....
 
dEdE' Alıntı:
Dener misiniz?
C++: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("J3:J100,C3:C100")) Is Nothing Then Exit Sub
    Cancel = True
If Target.Column = 3 Then _
    Target.EntireRow.Interior.Color = IIf(Target.Interior.Color = 65535, xlNone, 65535)
If Target.Column = 10 Then
    If ActiveCell.Interior.ColorIndex = 4 Then
        ActiveCell.Interior.ColorIndex = xlNone
        ActiveCell.Offset(-1, 0).Select
    Else
        ActiveCell.Interior.ColorIndex = 4
        ActiveCell.Offset(-1, 0).Select
    End If
End If
End Sub
Genişletmek için tıkla ...
Değerli deDE hocam tekrar merhaba :) . Bu koda ekleme olarak tıklanınca hizasındaki BO sütununa o anki tarih ve saat ve dakka saniye bilgisini yazabilirmi acaba ? ödeme yaptığımda çift tıklıcam ve BO3:BO100 hizasına ne zaman yaptığım belli olsun diye istiyorum .

Sağlıcakla kalın Değerli hocam..
 
Merhaba,
- Hangi sütuna tıklanınca Tarih/Saat/Dakika/Saniye yazılacak belirtmemişsiniz. Ben C sütunu olarak aldım ve yanıtı buna göre yazdım. Kodlar aşağıdadır.
C++: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("J3:J100,C3:C100")) Is Nothing Then Exit Sub
    Cancel = True
If Target.Column = 3 Then
    Target.EntireRow.Interior.Color = IIf(Target.Interior.Color = 65535, xlNone, 65535)
    Cells(Target.Row, 67) = Format(Now, "dd.mm.yyyy ss:dd:nn")
End If

If Target.Column = 10 Then
    If ActiveCell.Interior.ColorIndex = 4 Then
        ActiveCell.Interior.ColorIndex = xlNone
        ActiveCell.Offset(-1, 0).Select
    Else
        ActiveCell.Interior.ColorIndex = 4
        ActiveCell.Offset(-1, 0).Select
    End If
End If
End Sub
 
Son düzenleme:
dEdE' Alıntı:
Merhaba,
- Hangi sütuna tıklanınca Tarih/Saat/Dakika/Saniye yazılacak belirtmemişsiniz. Ben C sütunu olarak aldım ve yanıtı buna göre yazdım. Kodlar aşağıdadır.
C++: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("J3:J100,C3:C100")) Is Nothing Then Exit Sub
    Cancel = True
If Target.Column = 3 Then
    Target.EntireRow.Interior.Color = IIf(Target.Interior.Color = 65535, xlNone, 65535)
    Cells(Target.Row, 67) = Format(Now, "dd.mm.yyyy ss:dd:nn")
End If

If Target.Column = 10 Then
    If ActiveCell.Interior.ColorIndex = 4 Then
        ActiveCell.Interior.ColorIndex = xlNone
        ActiveCell.Offset(-1, 0).Select
    Else
        ActiveCell.Interior.ColorIndex = 4
        ActiveCell.Offset(-1, 0).Select
    End If
End If
End Sub
Genişletmek için tıkla ...
Değerli Hocam Haklısınız J ye göre istemiştim ama J ye göre uyarladım kodu.bide HH:MM:SS şeklinde saat formatını ayarladım.. çok çok teşekkür ederim.ödeme yaptığım anın vaktini öğrenmiş oldum sayenizde.güvenlik kamerasındanda bulmak kolaylaştı böylece..Kodun j ye göre uyarlanmış hali aşağıda..tekrar çok çok teşekkür ederim değerli hocam..Hastanızızzz :)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("J3:J100,C3:C100")) Is Nothing Then Exit Sub
Cancel = True
If Target.Column = 3 Then
Target.EntireRow.Interior.Color = IIf(Target.Interior.Color = 65535, xlNone, 65535)
End If

If Target.Column = 10 Then
If ActiveCell.Interior.ColorIndex = 4 Then
ActiveCell.Interior.ColorIndex = xlNone
ActiveCell.Offset(-1, 0).Select
Else
ActiveCell.Interior.ColorIndex = 4
ActiveCell.Offset(-1, 0).Select
Cells(Target.Row, 67) = Format(Now, "dd.mm.yyyy HH:MM:SS")
End If
End If
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst