Makro ile Sayısal Kat uygulama

[omeryılmaz]

Merhaba Arkadaşlar

Konu;

Label11.Caption = WorksheetFunction.CountIf(Sheets("DATA").Range("H2:H65536"), Label10.Caption)

Sütunda kayıtlı Aynı isimde verileri Labelede saydırıyorum
İlk 15 i için "2A1" ikinci 15 i için "2A2" üçüncü onbeşi için "2A3"...... devam eden arşivleme yapmam gerekli
Bununla ilgili işlem yürüyor.

Sorum aşağıdaki kod

atas1.Caption = ""
a = Val(Label11.Caption)
If a >= 0 And a <= 15 Then ' 15
atas1.Caption = ""
ElseIf a >= 16 And a <= 30 Then ' 30
atas1.Caption = "1"
ElseIf a >= 31 And a <= 45 Then ' 45
atas1.Caption = "2"
ElseIf a >= 46 And a <= 60 Then ' 60
atas1.Caption = "3"
ElseIf a >= 61 And a <= 75 Then
atas1.Caption = "4"
ElseIf a >= 76 And a <= 90 Then
atas1.Caption = "5"
ElseIf a >= 91 And a <= 105 Then
atas1.Caption = "6"
ElseIf a >= 106 And a <= 120 Then
atas1.Caption = "7"
ElseIf a >= 121 And a <= 135 Then
atas1.Caption = "8"
ElseIf a >= 136 And a <= 150 Then
atas1.Caption = "9"
ElseIf a >= 151 And a <= 165 Then
atas1.Caption = "10"
ElseIf a >= 166 And a <= 180 Then
atas1.Caption = "11"
ElseIf a >= 181 And a <= 195 Then
atas1.Caption = "12"
ElseIf a >= 196 And a <= 210 Then
atas1.Caption = "13"
ElseIf a >= 211 And a <= 225 Then
atas1.Caption = "14"
ElseIf a >= 226 And a <= 240 Then
atas1.Caption = "15"
ElseIf a >= 241 And a <= 255 Then
atas1.Caption = "16"
ElseIf a >= 256 And a <= 270 Then
atas1.Caption = "17"
ElseIf a >= 271 And a <= 285 Then
atas1.Caption = "18"
ElseIf a >= 286 And a <= 300 Then
atas1.Caption = "19"
ElseIf a >= 301 And a <= 315 Then
atas1.Caption = "20"
ElseIf a >= 316 And a <= 330 Then
atas1.Caption = "21"
ElseIf a >= 331 And a <= 345 Then
atas1.Caption = "22"
ElseIf a >= 346 And a <= 360 Then
atas1.Caption = "23"
ElseIf a >= 361 And a <= 375 Then
atas1.Caption = "24"
ElseIf a >= 376 And a <= 390 Then
atas1.Caption = "25"
ElseIf a >= 391 And a <= 405 Then
atas1.Caption = "25"
End If ' Kod devam edecek

Bu kodu Nasıl kısaltırım..

Yapacağınız yardım ve önerileriniz için şimdiden şükranlarımı sunuyorum

 

[Huseyinkis]

Ekteki gibi denermisiniz 10000'e kadar yaptım işlemi

atas1.Caption = ""
a = Val(Label11.Caption)
deger = -1

For x1 = 1 To 10000 Step 15
deger = deger + 1
If a >= x1 And a <= x1 + 14 Then
If deger = 0 Then
atas1.Caption = ""
Else
atas1.Caption = deger
End If
End If
Next

 

[omeryılmaz]

Ekteki gibi denermisiniz 10000'e kadar yaptım işlemi

atas1.Caption = ""
a = Val(Label11.Caption)
deger = -1

For x1 = 1 To 10000 Step 15
deger = deger + 1
If a >= x1 And a <= x1 + 14 Then
If deger = 0 Then
atas1.Caption = ""
Else
atas1.Caption = deger
End If
End If
Next

Teşekkürler Hocam.....Eline sağlık....