SubTotal

[vba_man]

[vb:1:eaa6dc7eb4]
Global sayi1 As Long, sayi2 As Long, say As Long
Global rng1 As Range, rng2 As Range, bul As Range
Global Col As New Collection
Global Sor As String, IlkAdres As String

Sub AltTopla()
say = WorksheetFunction.CountA(Sheets(2).Range("A:A"))
Sheets(2).Range("A2:IU" & say).RemoveSubtotal

Sheets(2).Range("A3:IU" & say).Sort Range("A3"), xlAscending

Sor = Application.InputBox("Hangi Sütuna Göre Toplam Alınacak?", "", 1)
On Error Resume Next
For sayi1 = 18 To 254
If sayi1 Mod 5 <> 1 And sayi1 Mod 5 <> 2 Then
Col.Add sayi1
End If
Next sayi1

For sayi1 = 1 To Col.Count
sayac = Col(sayi1)
Next sayi1

Sheets(2).Range("A2:IU" & say).Subtotal Sor, xlSum, Array(sayac)

End Sub[/vb:1:eaa6dc7eb4]
Array(sayac) yazan alanda 18 ile 254 arasında bulunan ve mod 5'e göre 1 ve 2 olmayan değerlerin yazılmasını ve böylece alt toplam sütunlarının otomatik belirlenmesi için ne yapmam gerekir.
Yani:
18-19-20 (21-22 yok)
23-24-25 (26-27 yok)
28-29-30 (31-32 yok)
33-34-35 (36-37 yok) şeklinde 254 e kadar gidecek. Bu işlemi Collection sayesinde gerçekleştirebildim ancak, Array(sayac) yazan alana nasıl uyarlarım.

Normalde Sheets(2).Range("A2:IU" & say).Subtotal Sor, xlSum, Array(18,19,20,23,24,25,28,29,30,33,34,35......254)'e kadar yazsam olacaktı.