şartlı kalan durumu

[sensizsoldum]

Merhaba, hayırlı sabahlar,
arkadaşlar listeye göre takıp yaptığım bi çalışma hazırlandı.
2 satırda ki formüller excel formülü olduğundan sayfann yavaş çalışmasına neden oluyor.
ayrıca b2 hücresinde 1000 kadar verileri alıyor bunu yükseltiğimiz zaman, daha da yavaşlıyor.
bu çalışmayı tamamen makrolu yapabilirmıyız.
konu hakkında da bana yardımcı olurmusunuz.
ilgi ve alakalarınıza sonsuz teşekkürlerimi iletirim.
örnek dosya aşağıdaki linktedir.
http://s2.dosya.tc/server6/HV5XYD/_rnek.xls.html

 

[Husgvarna]

Merhaba.
Kodlarınıza kırmızı bölümleri ekleyin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target.Cells, Range("b3:b65536")) Is Nothing Then Exit Sub
Range("A3:c65536").Interior.ColorIndex = xlNone
[c3:c65536] = ""
If Cells(65536, 1).End(xlUp).Row < Cells(65536, 2).End(xlUp).Row Then
t = Cells(65536, 2).End(xlUp).Row
Else
t = Cells(65536, 1).End(xlUp).Row
End If
For a = 3 To t
If WorksheetFunction.CountIf([b3:b65536], Cells(a, 1)) > 0 Then Cells(a, 1).Interior.ColorIndex = 4
If WorksheetFunction.CountIf([a3:a65536], Cells(a, 2)) > 0 Then
Cells(a, 2).Interior.ColorIndex = 4
[COLOR="#ff0000"]S = S + 1[/COLOR]
Cells(a, 3).Interior.ColorIndex = 4
Cells(a, 3) = "SEND"
Else
If Cells(a, 2) <> "" Then
Cells(a, 2).Interior.ColorIndex = 3
Cells(a, 3).Interior.ColorIndex = 3
Cells(a, 3) = "WARNİNG"
End If
   End If
  Next
[COLOR="Red"]  [a2] = Cells(65000, 1).End(xlUp).Row - 2
  [b2] = S
  [c2] = [a2] - [b2]
  [d2] = Application.Sum(Range("d3:d65500"))
  [e2] = [b2] - [d2][/COLOR]
End Sub

 

[sensizsoldum]

Merhaba çok tşk ederim çok sağolun,
buna son olarak bişey daha rica edebilirmiyim...
c2 sutunda sizinde anladığınız üzere liste ye ait kalan adetlerini bilmek istıyorum.
a sutunda 1 den 9 kadar rakam olduğunu varsayalım.
b sutunda da bu listeden her rakamdan 1 den fazla eklendiğini varsayalım
yani a sutunda 9 tane var b sutunda 35 tane var. b sutunda listeye ait bu rakamlar 1den fazla olsada 1 tane olmasını sağlayabilirmıyız
örnek yapacak olursak a sutunda 2 nolu veriden 1 tane var. b sutunda ise bu 2 nolu veriden 7 tane var, bunu b sutununda 1 tane olmasından söz ediıyorum.
ancak bu işlemin sonucunu sadece c2 sutunda olmasını istıyorum.
diğer hücrelere değilişklık yapılmamalıdır.

tekrardan çok tşk ederım. sizleri yoruyuroum belki ama eksiklıkleri bişeyler yapıldıkça göruyorum. sanırsam buda son.

çok sağolun ıyı çalışmalar dilerim.

 

[Husgvarna]

Şöyle bir deneyin.
Satır sayısının çokluğuna göre ağırlaşacaktır.

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target.Cells, Range("b3:b65536")) Is Nothing Then Exit Sub
Range("A3:c65536").Interior.ColorIndex = xlNone
[c3:c65536] = ""
If Cells(65536, 1).End(xlUp).Row < Cells(65536, 2).End(xlUp).Row Then
t = Cells(65536, 2).End(xlUp).Row
Else
t = Cells(65536, 1).End(xlUp).Row
End If
For a = 3 To t

If WorksheetFunction.CountIf([b3:b65536], Cells(a, 1)) > 0 Then Cells(a, 1).Interior.ColorIndex = 4
If WorksheetFunction.CountIf([a3:a65536], Cells(a, 2)) > 0 Then
Cells(a, 2).Interior.ColorIndex = 4
S = S + 1
If Cells(a, 2) <> "" Then
If WorksheetFunction.CountIf(Range("b3:b" & a), Cells(a, 2)) = 1 Then Ss = Ss + 1
End If

Cells(a, 3).Interior.ColorIndex = 4
Cells(a, 3) = "SEND"
Else
If Cells(a, 2) <> "" Then
Cells(a, 2).Interior.ColorIndex = 3
Cells(a, 3).Interior.ColorIndex = 3
Cells(a, 3) = "WARNİNG"
End If
   End If
  Next
  [a2] = Cells(65000, 1).End(xlUp).Row - 2
  [b2] = S
[c2] = [a2] - Ss
  [d2] = Application.Sum(Range("d3:d65500"))
  [e2] = [b2] - [d2]
End Sub

 

[sensizsoldum]

merhaba,
yanlış yanlış anlaşılma söz konusu, sanırsam. istediğim bu şekılde değil,
örnek verecek olursak...
a sutuna 1den 5 e kadar rakamlardan oluşan liste girişi yaptım.
b sutuna da bu girilen listeden 4 tanesinden 3 tane giriş yapıldı. 1inden hala giriş yapılmadı.
kalanda 1 olması gerek.
ancak ben b sutuna a da ki listeden tek bitane girebiliyorum. a sutunda listede 1 tane olabilir ama
b ye girilen birden fazla olması gerekmekte. giriş yapamıyorum.
a2 ve b2 de toplamlarda bi değişiklık olmamalıdır. sadece bu istediğim sonuc c2 de olmalıdır.


ilginize tekrardan tşk ederım.

 

[Husgvarna]

Merhaba.
İkinci eklenen kod değişti deneyiniz.

 

[sensizsoldum]

tşk ederim çok sağolun tam istediğim gibi. allah razı olsun.
hakkınızı helal edin lutfen iyi akşamlar dilerim.

 

[Husgvarna]

tşk ederim çok sağolun tam istediğim gibi. allah razı olsun.
hakkınızı helal edin lutfen iyi akşamlar dilerim.

Rica ederim.İyi akşamlar.