• DİKKAT

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

REHBERLİK ONLİNE ENVANTER ÖLÇEĞİ

hakta85

Altın Üye
Katılım
17 Aralık 2014
Mesajlar
116
Excel Vers. ve Dili
xls. 2007
MERHABALAR DEĞERLİ ARKADAŞLAR BU ALAN ÜZERİNDE MAKRO VAR 2 KEZ TIKLADIĞINDA
SİYAH OLARAK İŞARETLİYOR YAPMAK İSTEDİĞİM İŞARETLEME YAPARAK 0 İLE 4 ARASINDAKİ SAYILARI TOPLAMAK? İSTİYORUM YARDIMCI OLURSANIZ ÇOK SEVİNİRİM.
 

Ekli dosyalar

MERHABA ARKADAŞLAR EKTEKİ KONU HAKKINDA YARDIMLARINIZI BEKLİYORUM ÇÖZÜMÜ OLAN ARKADAŞLARIN DESTEKLERİNİ BEKLİYORUM ŞİMDİDEN TEŞEKKÜR EDERİM.
 
Merhaba @hakta85

Dosyanızı, dış serverler'den birine yükleyip link paylaşabilir misiniz.
 
İLGİNİZ VE EMEKLERİNİZ İÇİN TEŞEKKÜR EDERİM.
 
Merhaba @hakta85

Mevut kodunuzu aşağıdaki gibi değiştirip dener misiniz.
Toplamı H18 hücresine yazıp, Siyah olarak işaretli sayıları toplamaktadır.

C#:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Interior.Color = vbBlack Then
            Target.Interior.Color = vbWhite
            Target.Font.Color = vbBlack
            Cells(Target.Row + 1, Target.Column).Select
        GoTo gittopla
        Exit Sub
    End If

If Intersect(Target, Range("B11:G22")) Is Nothing Then GoTo devam1
        Range(Cells(Target.Row, "B"), Cells(Target.Row, "B")).Interior.Color = vbWhite
        Range(Cells(Target.Row, "B"), Cells(Target.Row, "B")).Font.Color = vbBlack
       
        Target.Interior.Color = vbBlack
        Target.Font.Color = vbWhite
        Cells(Target.Row + 1, Target.Column).Select
   
gittopla:
    For Each Rng In Range("C13:G22")
    If Rng.Interior.Color = vbBlack Then vr = vr + Rng
    Next Rng
    Range("H18") = vr
devam1:
End Sub
 
ÇOK TEŞEKKÜR EDERİM İSTEDİĞİM GİBİ OLMUŞ SAĞOLUN
 
Merhaba @hakta85

Mevut kodunuzu aşağıdaki gibi değiştirip dener misiniz.
Toplamı H18 hücresine yazıp, Siyah olarak işaretli sayıları toplamaktadır.

C#:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Interior.Color = vbBlack Then
            Target.Interior.Color = vbWhite
            Target.Font.Color = vbBlack
            Cells(Target.Row + 1, Target.Column).Select
        GoTo gittopla
        Exit Sub
    End If

If Intersect(Target, Range("B11:G22")) Is Nothing Then GoTo devam1
        Range(Cells(Target.Row, "B"), Cells(Target.Row, "B")).Interior.Color = vbWhite
        Range(Cells(Target.Row, "B"), Cells(Target.Row, "B")).Font.Color = vbBlack
      
        Target.Interior.Color = vbBlack
        Target.Font.Color = vbWhite
        Cells(Target.Row + 1, Target.Column).Select
  
gittopla:
    For Each Rng In Range("C13:G22")
    If Rng.Interior.Color = vbBlack Then vr = vr + Rng
    Next Rng
    Range("H18") = vr
devam1:
End Sub
MERHABALAR ŞİMDİ BEN SİZİN GÖNDERDİĞİNİZ KODU 2 FARKLI ŞEKİLDE DÜZENLEMEYE ÇALIŞTIM AMA TEK SORUN 2 KEZ TIKLADIĞINDA İŞARTLEME VE TOPLAMA İŞLEMİ YAPIYOR AYNI ŞEKİLDE 2 TIKLADIMDA İŞARETLEMEYİ KALDIRMIYOR VE TOPLAMADAN SAYI VE ŞIK DÜŞMÜYOR BU KONUDA YARDIMCI OLURSANIZ SEVİNİRİM ÇOK TEŞEKKÜR EDERİM. BEN NERDE YANLIŞ YAPIYORUM.?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Interior.Color = vbBlack Then
Target.Interior.Color = vbWhite
Target.Font.Color = vbBlack
Cells(Target.Row + 1, Target.Column).Select
GoTo gittopla
Exit Sub
End If

If Intersect(Target, Range("B11:H23")) Is Nothing Then GoTo devam1
Range(Cells(Target.Row, "B"), Cells(Target.Row, "B")).Interior.Color = vbWhite
Range(Cells(Target.Row, "B"), Cells(Target.Row, "B")).Font.Color = vbBlack

Target.Interior.Color = vbBlack
Target.Font.Color = vbWhite
Cells(Target.Row + 1, Target.Column).Select

gittopla:
For Each Rng In Range("D13:H23")
If Rng.Interior.Color = vbBlack Then vr = vr + Rng
Next Rng
Range("X18") = vr
devam1:

If Intersect(Target, Range("C11:w23")) Is Nothing Then GoTo devam1
Range(Cells(Target.Row, "C"), Cells(Target.Row, "C")).Interior.Color = vbWhite
Range(Cells(Target.Row, "C"), Cells(Target.Row, "C")).Font.Color = vbBlack

Target.Interior.Color = vbBlack
Target.Font.Color = vbWhite
Cells(Target.Row + 1, Target.Column).Select

gittopla1:
For Each Rng In Range("I13:W23")
If Rng.Interior.Color = vbBlack Then vx = vx + Rng
Next Rng
Range("X16") = vx
devam2:
End Sub
 
MERHABALAR ŞİMDİ BEN SİZİN GÖNDERDİĞİNİZ KODU 2 FARKLI ŞEKİLDE DÜZENLEMEYE ÇALIŞTIM AMA TEK SORUN 2 KEZ TIKLADIĞINDA İŞARTLEME VE TOPLAMA İŞLEMİ YAPIYOR AYNI ŞEKİLDE 2 TIKLADIMDA İŞARETLEMEYİ KALDIRMIYOR VE TOPLAMADAN SAYI VE ŞIK DÜŞMÜYOR BU KONUDA YARDIMCI OLURSANIZ SEVİNİRİM ÇOK TEŞEKKÜR EDERİM. BEN NERDE YANLIŞ YAPIYORUM.?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Interior.Color = vbBlack Then
Target.Interior.Color = vbWhite
Target.Font.Color = vbBlack
Cells(Target.Row + 1, Target.Column).Select
GoTo gittopla
Exit Sub
End If

If Intersect(Target, Range("B11:H23")) Is Nothing Then GoTo devam1
Range(Cells(Target.Row, "B"), Cells(Target.Row, "B")).Interior.Color = vbWhite
Range(Cells(Target.Row, "B"), Cells(Target.Row, "B")).Font.Color = vbBlack

Target.Interior.Color = vbBlack
Target.Font.Color = vbWhite
Cells(Target.Row + 1, Target.Column).Select

gittopla:
For Each Rng In Range("D13:H23")
If Rng.Interior.Color = vbBlack Then vr = vr + Rng
Next Rng
Range("X18") = vr
devam1:

If Intersect(Target, Range("C11:w23")) Is Nothing Then GoTo devam1
Range(Cells(Target.Row, "C"), Cells(Target.Row, "C")).Interior.Color = vbWhite
Range(Cells(Target.Row, "C"), Cells(Target.Row, "C")).Font.Color = vbBlack

Target.Interior.Color = vbBlack
Target.Font.Color = vbWhite
Cells(Target.Row + 1, Target.Column).Select

gittopla1:
For Each Rng In Range("I13:W23")
If Rng.Interior.Color = vbBlack Then vx = vx + Rng
Next Rng
Range("X16") = vx
devam2:
End Sub
EN SON OLUŞTURDUĞUM KODLAMADA ABCD ŞIKLARINI ÇALIŞIYOR SADECE SAYILARIN İŞARETLEMESİNİ YAPMIYOR VE TOPLAMIYOR

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Interior.Color = vbBlack Then
Target.Interior.Color = vbWhite
Target.Font.Color = vbBlack
Cells(Target.Row + 1, Target.Column).Select
GoTo gittopla
Exit Sub
End If

If Intersect(Target, Range("B11:H23")) Is Nothing Then GoTo devam1
Range(Cells(Target.Row, "B"), Cells(Target.Row, "B")).Interior.Color = vbWhite
Range(Cells(Target.Row, "B"), Cells(Target.Row, "B")).Font.Color = vbBlack

Target.Interior.Color = vbBlack
Target.Font.Color = vbWhite
Cells(Target.Row + 1, Target.Column).Select

gittopla:
For Each Rng In Range("D13:H23")
If Rng.Interior.Color = vbBlack Then vr = vr + Rng
Next Rng
Range("X18") = vr
devam1:
Exit Sub
devam2:
If Target.Interior.Color = vbBlack Then
Target.Interior.Color = vbWhite
Target.Font.Color = vbBlack
Cells(Target.Row + 1, Target.Column).Select
GoTo gittopla2
Exit Sub
End If

If Intersect(Target, Range("I14:W23")) Is Nothing Then GoTo devam2
Range(Cells(Target.Row, "I"), Cells(Target.Row, "I")).Interior.Color = vbWhite
Range(Cells(Target.Row, "I"), Cells(Target.Row, "I")).Font.Color = vbBlack

Target.Interior.Color = vbBlack
Target.Font.Color = vbWhite
Cells(Target.Row + 1, Target.Column).Select

gittopla2:
For Each Rng In Range("I13:W23")
If Rng.Interior.Color = vbBlack Then vr = vr + Rng
Next Rng
Range("X17") = vr

End Sub
 
[QUOTE = "Hepgel, gönderi: 1054430, üye: 416027"]
Rica Ederim,
İyi Çalışmalar.
[/QUOTE]
EN SON OLUŞTURDUĞUM KODLAMADA ABCD ŞIKLARINI calısıyor SADECE sayıların İŞARETLEMESİNİ yapmıyor TOPLAMIYOR VE

Private Sub Worksheet_BeforeDoubleClick (Aralık itibariyle ByVal Target olarak Boole İptal)
ise Target.Interior.Color = vbBlack Sonra
Target.Interior.Color = vbWhite
Target.Font.Color = vbBlack
Hücreler (Target.Row + 1, Target.Column).
GoTo gittopla
Exit Sub
End'i Kesişirse

(Hedef, Aralık ("B11: H23")) Hiçbir Şey Olmazsa Git1
Aralık (Hücreler (Target.Row, "B") , Hücreler (Target.Row, "B")). Interior.Color = vbWhite
Range (Hücreler (Target.Row, "B"), Hücreler (Target.Row, "B")). Font.Color = vbBlack

Target.Interior.Color = vbBlack
Target.Font.Color = vbWhite
Hücreleri (Target.Row + 1, Target.Column).

Gittopla'yı seçin : Aralıktaki
Her Aralık İçin ("D13: H23")
Eğer Rng.Interior.Color = vbBlack Sonra vr = vr + Aralık
Sonraki
Aralık Aralığı ("X18") = vr
devam1:
Alt
Alttan Çık devam2:
Target.Interior.Color = vbBlack ise Sonra
Target.Interior.Color = vbWhite
Target.Font.Color = vbBlack
Hücreler (Target.Row + 1, Target.Column).
GoTo gittopla2'yi Seçin Kesişse
Alt
Sonu Çık

(Hedef, Aralık ("I14: W23")) Hiçbir Şey Olmazsa Devam2
Aralık (Hücreler (Target.Row, "I"), Hücreler (Target.Row, "I")). Interior.Color = vbWhite
Range (Cells (Target.Row, "I"), Hücreler (Target.Row, " I ")). Font.Color = vbBlack

Target.Interior.Color = vbBlack
Target.Font.Color = vbWhite
Hücreler (Target.Row + 1, Target.Column).

Gittopla2'yi seçin : Aralıktaki
Her Aralık İçin (" I13: W23 ")
Eğer Rng.Interior.Color = vbBlack O zaman vr = vr + Rng
Sonraki Rng
Aralığı (" X17 ") = vr

End Sub

alıntı Cevapla
Bildiri
 
MERHABALAR DEĞERLİ ARKDAŞLAR GÖNDERMİŞ OLDUĞUM KONU İLE İLGİLİ YARDIMLARINIZI BEKLİYORUM HERKESİN ELİNE EMEĞİNE SAĞLIK DESTEKLERİNİZİ BEKLİYORUM
 
[QUOTE = "Hepgel, gönderi: 1054430, üye: 416027"]
Rica Ederim,
İyi Çalışmalar.
[/QUOTE]
MERHABALAR SİZİN YAZMIŞ OLDUĞUNUZ KODU KULLANDIM ÇALIŞTI YANLIZ AYNI KODU SAYILARI TOPLAMAK İÇİN YAPMAK İSTEDİĞİMDE HATA VERİYOR BU KONUDA YARDIMCI OLURSANIZ ÇOK SEVİNİRİM TEŞEKKÜRLER ŞİMDİDEN
 

Ekli dosyalar

Bu önceki dosyadan farklı
Puanlama nasıl yapılacak.
A işaretli olunca kaç puan, B işaretli olunca kaç puan gibi.
 
Bu önceki dosyadan farklı
Puanlama nasıl yapılacak.
A işaretli olunca kaç puan, B işaretli olunca kaç puan gibi.
puanlama alanında toplamı verse yeter bazen puan aralıkları değişiyor bazende standart olarak kalıyor birde soru sayısı değişkenlik gösterecek bu sebep ile bana toplamı verse yeterli olacaktır.
 
puanlama alanında toplamı verse yeter bazen puan aralıkları değişiyor bazende standart olarak kalıyor birde soru sayısı değişkenlik gösterecek bu sebep ile bana toplamı verse yeterli olacaktır.
merhabalar Hepgel konu ilgili bakabildiniz mi acaba ilgi alakanız için teşekkür ederim.
 
A harfine çift tıkladım, siyah oldu kaç puan sayacak.
B harfine tıkladım siyah oldu kaç puan olacak.
Konu sizin işiniz olduğu için size basit geliyor ve bizim de anlayabileceğimizi düşünüyorsunuz.
 
Geri
Üst