- Katılım
- 6 Mayıs 2014
- Mesajlar
- 264
- Excel Vers. ve Dili
- office 365
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub sayısay()
Dim s1 As Worksheet: Dim s2 As Worksheet
Dim i As Integer: Dim ii As Integer
Set s1 = Sheets("A"): Set s2 = Sheets("tablo")
Set wf = WorksheetFunction
s1.Range("F4:F13").ClearContents
For ii = 4 To 13
For i = 1 To 5
If wf.Count(s1.Range("A" & ii & ":" & "E" & ii)) = 0 Then GoTo 10
t = wf.CountIf(s2.Range("A4:E7"), s1.Cells(ii, i))
Tpl = Tpl + t
Next i
s1.Cells(ii, i) = Tpl
Tpl = 0
10:
Next ii
End Sub
Dönüş yaptığınız için teşekkür ederim.Elinize sağlık
Sub TEST_3()
Dim s1 As Worksheet: Dim s2 As Worksheet
Dim i As Integer: Dim ii As Integer
Set s1 = Sheets("A"): Set s2 = Sheets("tablo")
Set wf = WorksheetFunction
s1.Range("F4:F13").ClearContents
For ii = 4 To 13
For i = 1 To 5
If wf.Count(s1.Range("A" & ii & ":" & "E" & ii)) = 0 Then GoTo 10
t = wf.CountIf(s2.Range("A4:E7"), s1.Cells(ii, i))
Tpl = Tpl + t
Next i
s1.Cells(ii, i) = Tpl
Tpl = 0
10:
Next ii
End Sub
s1.Range("F4:F13").ClearContents
s1.Range("F4:F").ClearContents
Set s1 = Sheets("A"): Set s2 = Sheets("tablo")
Set wf = WorksheetFunction
sonsatir_s1 = s1.Cells(Rows.Count, "H").End(xlUp).Row
s1.Range("F4:F" & sonsatir_s1).ClearContents
's1.Range("F4:F13").ClearContents
sonsatir_s2 = s2.Range("E" & Rows.Count).End(xlUp).Row
For ii = 4 To sonsatir_s1
'For ii = 4 To 13
For i = 1 To 5
If wf.Count(s1.Range("A" & ii & ":" & "E" & ii)) = 0 Then GoTo gec
'If wf.Count(s1.Range("A" & ii & ":" & "E" & ii)) = 0 Then GoTo 10
x = wf.CountIf(s2.Range("A4:E" & sonsatir_s2), s1.Cells(ii, i))
't = wf.CountIf(s2.Range("A4:E" & sonsatir_s2), s1.Cells(ii, i))
't = wf.CountIf(s2.Range("A4:E7"), s1.Cells(ii, i))
Sonuc = Sonuc + x
'Tpl = Tpl + t
Next i
s1.Cells(ii, i) = Sonuc
's1.Cells(ii, i) = Tpl
Sonuc = 0
'Tpl = 0
gec:
'10:
Next ii
Ben bunu a sayfasındaki 4-13 arasındaki satır sayısı sanmıştım.GoTo 10 için de, 10 yerine istediğiniz bir değişken yazabilirsiniz.
Örnek olarak, If wf.Count(s1.Range("A" & ii & ":" & "E" & ii)) = 0 Then GoTo gec
Bu satırın anlamı, A ve E arasındaki hücrelerde değer yoksa diğer satıra geç, bu nedenle Next ii satırından önce yazılmış.