• DİKKAT

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

0001 den 3000 e kadar her bir sayıdan kaç tane olduğunu bulmak ?

B

BASKICI

Katılım
5 Ocak 2011
Mesajlar
82
Excel Vers. ve Dili
Excel 2003
Selamlar.. Userform üzerinden sayfalara bilgi girişi yapıyorum. Düşündüğüm şu. ben belli 2 hücreye mesela a2 ile d2 ye örneğin a2 ye 0001 d2 ye 3000 yazacağım. Alt tarafta kaç tane 0 var kaç tane 1 var yanyana hücrelere ayrı ayrı yazacak. Benim numara sistemimde 1 kağıtta 1 den 4 adet , diğerlerinden 2 şer adet var. Kaç tane sıfır varsa bunu da bir alt hücrede 2 ye bölecek mesela... Böyle birşey mümkün mü ?
 
Sayın hüseyinkis öncelikle ilginiz için teşekkür ederim. mesela 0001 ile 3000 arasındaki bütün sayıları kapsayacak istediğim şey. Yani 0001,0002,0003......2999,3000 şeklinde. Bu aralıkta kaç tane sıfır varsa belli bir hücreye onu kaçtane bir varsa bir başka hücreye de onu yazacak.
 
Merhabalar;

Sorunuz çok net bir soru değil.ben anladığım haliyle bir örnek dosya yaptım.Dosyada 0001-0500'e kadar sayıları yerleştirdim.Siz bu sayıları 3000'e kadar çoğaltırsınız.A1 ve B1 e yazacağınız sayı aralığında her bir rakamdan kaçar tane olduğunu yandaki hücrelerde göreceksiniz.

Umarım yardımcı olur..Kolay gelsin..
 

Ekli dosyalar

Sayın peleryn ; ilginiz ve alakanız için çok teşekkür ederim.Kendimi yeterince anlatamadığım içinde kusura bakmayın.İstediğim tam olarak buydu. Yönteminiz gerçekten çok güzel. Bir farklı sistemle bende formülle yapmıştım bunu. Ancak dosya boyutunu çok yükseltiyor. O yüzden VBA kodu diye düşünmüştüm . Ama ona VBA da bir çözüm bulana kadar bunu kullanacağım gibi gözüküyor.
 
İşinizi görmesine sevindim.Dilerim umduğunuz gibi makro ile bir çözümünü de bulursunuz.İyi çalışmalar dilerim.
 
BASKICI' Alıntı:
Sayın peleryn ; ilginiz ve alakanız için çok teşekkür ederim.Kendimi yeterince anlatamadığım içinde kusura bakmayın.İstediğim tam olarak buydu. Yönteminiz gerçekten çok güzel. Bir farklı sistemle bende formülle yapmıştım bunu. Ancak dosya boyutunu çok yükseltiyor. O yüzden VBA kodu diye düşünmüştüm . Ama ona VBA da bir çözüm bulana kadar bunu kullanacağım gibi gözüküyor.
Genişletmek için tıkla ...

Merhaba ekteki dosyayı incelermisiniz. Sanırım işinizi hızlandıracaktır.
 

Ekli dosyalar

BASKICI' Alıntı:
Sayın hüseyinkis;
Çok teşekkür ederim. :bravo: :mutlu:
Genişletmek için tıkla ...

Kodları Aşağıdaki gibi Değiştirin.

Kod: 
Sub Makro1()
Dim HK0, HK1, HK2, HK3, HK4, HK5, HK6, HK7
Dim HK8, HK9
HK0 = 0: HK1 = 0: HK2 = 0: HK3 = 0: HK4 = 0: HK5 = 0: HK6 = 0: HK7 = 0: HK8 = 0: HK9 = 0
Set Katsayı = Range("A3").Value * 1
For i = Range("A1").Value To Range("A2").Value
If Len(i) < 2 Then
HK0 = HK0 + 3
GoTo git1:
ElseIf Len(i) < 3 Then
HK0 = HK0 + 2
GoTo git1:
ElseIf Len(i) < 4 Then
HK0 = HK0 + 1
GoTo git1:
ElseIf Len(i) = 4 Then
GoTo git1:
End If

git1:
Tan1 = Mid(i, 1, 1)
If Tan1 = 1 Then
HK1 = HK1 + 1 * Katsayı
ElseIf Tan1 = 2 Then
HK2 = HK2 + 1 * Katsayı
ElseIf Tan1 = 3 Then
HK3 = HK3 + 1 * Katsayı
ElseIf Tan1 = 4 Then
HK4 = HK4 + 1 * Katsayı
ElseIf Tan1 = 5 Then
HK5 = HK5 + 1 * Katsayı
ElseIf Tan1 = 6 Then
HK6 = HK6 + 1 * Katsayı
ElseIf Tan1 = 7 Then
HK7 = HK7 + 1 * Katsayı
ElseIf Tan1 = 8 Then
HK8 = HK8 + 1 * Katsayı
ElseIf Tan1 = 9 Then
HK9 = HK9 + 1 * Katsayı
ElseIf Tan1 = 0 Then
HK0 = HK0 + 1 * Katsayı
End If

If Len(i) < 2 Then
GoTo Son:
ElseIf Len(i) < 5 Then
GoTo Git2:
End If

Git2:
Tan2 = Mid(i, 2, 1)
If Tan2 = 1 Then
HK1 = HK1 + 1 * Katsayı
ElseIf Tan2 = 2 Then
HK2 = HK2 + 1 * Katsayı
ElseIf Tan2 = 3 Then
HK3 = HK3 + 1 * Katsayı
ElseIf Tan2 = 4 Then
HK4 = HK4 + 1 * Katsayı
ElseIf Tan2 = 5 Then
HK5 = HK5 + 1 * Katsayı
ElseIf Tan2 = 6 Then
HK6 = HK6 + 1 * Katsayı
ElseIf Tan2 = 7 Then
HK7 = HK7 + 1 * Katsayı
ElseIf Tan2 = 8 Then
HK8 = HK8 + 1 * Katsayı
ElseIf Tan2 = 9 Then
HK9 = HK9 + 1 * Katsayı
ElseIf Tan2 = 0 Then
HK0 = HK0 + 1 * Katsayı
End If

If Len(i) < 3 Then
GoTo Son:
ElseIf Len(i) < 5 Then
GoTo git3:
End If

git3:

Tan3 = Mid(i, 3, 1)
If Tan3 = 1 Then
HK1 = HK1 + 1 * Katsayı
ElseIf Tan3 = 2 Then
HK2 = HK2 + 1 * Katsayı
ElseIf Tan3 = 3 Then
HK3 = HK3 + 1 * Katsayı
ElseIf Tan3 = 4 Then
HK4 = HK4 + 1 * Katsayı
ElseIf Tan3 = 5 Then
HK5 = HK5 + 1 * Katsayı
ElseIf Tan3 = 6 Then
HK6 = HK6 + 1 * Katsayı
ElseIf Tan3 = 7 Then
HK7 = HK7 + 1 * Katsayı
ElseIf Tan3 = 8 Then
HK8 = HK8 + 1 * Katsayı
ElseIf Tan3 = 9 Then
HK9 = HK9 + 1 * Katsayı
ElseIf Tan3 = 0 Then
HK0 = HK0 + 1 * Katsayı
End If

If Len(i) < 4 Then
GoTo Son:
ElseIf Len(i) < 5 Then
GoTo git4:
End If

git4:
Tan4 = Mid(i, 4, 4)
If Tan4 = 1 Then
HK1 = HK1 + 1 * Katsayı
ElseIf Tan4 = 2 Then
HK2 = HK2 + 1 * Katsayı
ElseIf Tan4 = 3 Then
HK3 = HK3 + 1 * Katsayı
ElseIf Tan4 = 4 Then
HK4 = HK4 + 1 * Katsayı
ElseIf Tan4 = 5 Then
HK5 = HK5 + 1 * Katsayı
ElseIf Tan4 = 6 Then
HK6 = HK6 + 1 * Katsayı
ElseIf Tan4 = 7 Then
HK7 = HK7 + 1 * Katsayı
ElseIf Tan4 = 8 Then
HK8 = HK8 + 1 * Katsayı
ElseIf Tan4 = 9 Then
HK9 = HK9 + 1 * Katsayı
ElseIf Tan4 = 0 Then
HK0 = HK0 + 1 * Katsayı
End If
Son:
Next


Cells(2, 4).Value = HK0
Cells(2, 5).Value = HK1
Cells(2, 6).Value = HK2
Cells(2, 7).Value = HK3
Cells(2, 8).Value = HK4
Cells(2, 9).Value = HK5
Cells(2, 10).Value = HK6
Cells(2, 11).Value = HK7
Cells(2, 12).Value = HK8
Cells(2, 13).Value = HK9
End Sub
 
Hüseyin bey bugün çok kafanızı şişirdim hakkınızı helal ediniz. :) Allah razı olsun.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst