5 haneli birbirinden farklı sayı üretmek

[mustafakayiran]

iyi günler,
ekdeki dosyada sicil kod yazan yerlere birbirinden farklı sayılar üretmek istiyorum 5 haneli olacak ve birbiri ile aynı olmayacak ayrıca bir hücre boş olduğunda o hücreye otomatik farklı bir sayı yazacak ama diğer hücrelerdeki sayılar değişmeyecek çok şeymi istedim bilmiyorum ama böyle çok hücrem var bunlar sadece bir örnek her ay manüel olarak girmek ve aynı sayı varmı yokmu onu kontrol etmek çok zamanımı alıyor.
Şimdiden teşekkür ederim.
kolay gelsin

 

[mami68]

Merhabalar,

bu fonksiyonu denedinizmi

=S_SAYI_ÜRET()*50

yada

=S_SAYI_ÜRET()*5

 

[Ali]

Aşağıdaki kodları bir module ekleyiniz.

Kodlar McGimpsey aittir.

Public Function RandInt( _
        Optional ByVal nStart As Long = 1&, _
        Optional ByVal nEnd As Long = -2147483647) As Variant
              Dim vArr As Variant
        Dim vResult As Variant
        Dim nCount As Long
        Dim nIndex As Long
        Dim nRand As Long
        Dim nRows As Long
        Dim nCols As Long
        Dim i As Long
        Dim j As Long
        Application.Volatile
        If Not TypeOf Application.Caller Is Range Then Exit Function
        With Application.Caller
            nCount = .Count
            If nEnd < nStart Then nEnd = nStart + nCount - 1
            If nCount = 1 Then
                RandInt = CLng((nEnd - nStart) * Rnd() + nStart)
            ElseIf nCount > nEnd - nStart + 1 Then
                RandInt = CVErr(xlErrNum)
            Else
                nRows = .Rows.Count
                nCols = .Columns.Count
                nIndex = nEnd - nStart + 1
                ReDim vResult(1 To nRows, 1 To nCols)
                ReDim vArr(0 To nIndex - 1)
                For i = 0 To UBound(vArr)
                    vArr(i) = i + nStart
                Next i
                For i = 1 To nRows
                    For j = 1 To nCols
                        nRand = Int(Rnd() * nIndex)
                        nIndex = nIndex - 1
                        vResult(i, j) = vArr(nRand)
                        vArr(nRand) = vArr(nIndex)
                     Next j
                Next i
                RandInt = vResult
            End If
        End With
    End Function

Diyelim 10 ile 100 arası 30 adet benzersiz rastgele sayı üreteceksiniz.

A1 hücresine =RandInt(10;100) yazıp A30 hücresine kadar sürükleyiniz A1:A30 arası seçili iken formül çubuğunu tıklayın CTRL+SHIFT+ENTER tuşlarına basarak dizi formülü oluşturunuz.A1:A30 aralığını artık komple dizi formülü haline gelecektir.

Not: Bu aralıktaki herhangi bir sayıyı değiştirmeye kalktığınızda dizinin bir parçasını değiştiremezsiniz ibaresi alırsınız. Bu aralığı tekrar düzenlemek isteyebilirsiniz bu durumda A1:A30 aralığı mouse ile seçip bu sefer CTRL+ENTER tuşuna basıp farklı aralıkta sayı üretebilirsiniz.

.

 

[mustafakayiran]

bu şekilde istediğim gibi olmuyor malesef

 

[leumruk]

bu şekilde istediğim gibi olmuyor malesef

Merhaba,
Birz daha açıklama yapmalısınız. Sorunuz tam anlaşılmıyor. Örnekte dolu halde tablolar var. Bir anda tüm tabloların dolmasını mı istiyorsunuz; yoksa tek tek mi sayı vermek istiyorsunuz? Ayrıntılı bir açıklama yapar mısınız?

 

[mustafakayiran]

bir anda tablolarda dolabilir ama aynı sayılar olmayacak fakat 5 haneli olacak hepsi
fakat bazı zamanlarda sicil kod ları değişebiliyor bu değişikliği yaptığım zaman diğer hücrelerdeki sicil kodları ile aynı olup olmadığınıda kontrol etmek istiyorum
bazı öğrnekleri inceledim rasgele sayı üretme konusunda ama 5 haneli vermedi 4 haneli verdiğide oluyor fakat diğer sicil kodları ile karşılaştırma yapamadım eğer birbirine benzer hücreler var ise tekrar numara girilmesi konusunda uyarı vermeli
formül ilede diğer hücreleri kontrol imkanı nasıl olur bilemedim
yani şöyle 100 tane hücre var her hücrenin karşılığında farklı sicil numaraları var ve bu sicil numaralarının karşısındada 5 haneli şifre gibi sayılar var birbirinden farklı benzemeyen ayrı sütünlarda ve bu 100 hücredeki rakamlar 5 haneli olacak ve birbirinden farklı olacak tek seferdede girilebilir bazı zamanlarda elle değiştirme yapabilirim ama elle 100 hücreye farklı benzemeyen rakamlar girmek zor oluyor bunu basitleştirmek istiyorum
tekrar teşekkür ederim ilginiz için

 

[mustafakayiran]

yada kısaca şöyle söyleyim bir otel ve 500 tane odası var bu 500 tane odada 500 tane safe kasası var ve bu kasalara 5 haneli şifre giriliyor bu şifreler 500 safe kasasında aynı olmayacak hepsi birbirinden farklı olacak bunun kontrolünü yapmak istiyorum fakat bir odada yani safe kasasında şifre değişikliği yapacağım zaman bu verilere göre o safe kasasına gidip şifreyi vermek istiyorum bu şekilde işlerim daha kolay ve basit olacak çünkü ben bunu her yıl yinelemek zorunda kalıyorum yada her ay içinde bir kaç tane kasanın şifresini değiştirmek zorunda kalıyorum

 

[Ali]

bu şekilde istediğim gibi olmuyor malesef

Gayet güzel benzersiz sayı üretiyor.

.

 

[leumruk]

Merhaba,
Aşağıdaki örneği inceleyiniz. İstediğiniz gibi bir anda benzersiz sayılar üretiyor. Diğer kodla da elle girişlerinizde girdiğiniz sayının benzerinin olup olmadığını kontrol ediyor.

Sub kodver()
İlk = 3: Son = 22
Range("d3:d22,h3:h22,l3:l22,d27:d46,h27:h46,l27:l46").ClearContents
Randomize
For t = 1 To 2
For x = İlk To Son
For y = 4 To 12 Step 4
Tekrar:
sayi = Int(89999 * Rnd() + 10000)
Say = WorksheetFunction.CountIf(Range("d3:l46"), sayi)
If Say > 0 Then GoTo Tekrar
Cells(x, y) = sayi
Next
Next
İlk = 27: Son = 46
Next
MsgBox "İşlem tamam.", vbOKOnly + vbInformation, "DURUM"
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("d3:d22,h3:h22,l3:l22,d27:d46,h27:h46,l27:l46")) Is Nothing Then Exit Sub
Say = WorksheetFunction.CountIf(Range("d3:l46"), Target)
If Say > 1 Then
MsgBox "Bu sayı daha önce verilmiş, yeni bir sayı yazınız.", vbCritical, "UYARI"
Target = ""
End If
End Sub

 

[mustafakayiran]

Sayın leumruk, süper bu ne hız teşekkür ederim çok harika olmuş

 

[leumruk]

Sayın leumruk, süper bu ne hız teşekkür ederim çok harika olmuş

Rica ederim. İyi çalışmalar.k::

 

[mustafakayiran]

teşekkür ederim sizede iyi çalışmalar