DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
="(0212) "&RASTGELEARADA(100;999)&" "&RASTGELEARADA(0;99)&" "&RASTGELEARADA(0;99)
Karıştıracak derken?
Örneğinizde 4 rakamını 2 kere kullanmışsınız ama 1 rakamı hiç yok. Karıştırma yapılacaksa örneğiniz hatalı olmuş. Rastgele numara üretilecekse de aşağıdaki formülü kullanabilirsiniz.
Kod:="(0212) "&RASTGELEARADA(100;999)&" "&RASTGELEARADA(0;99)&" "&RASTGELEARADA(0;99)
=SOLDAN(D2;7)&PARÇAAL(YERİNEKOY(D2;" ";"");RASTGELEARADA(7;13);1)&PARÇAAL(YERİNEKOY(D2;" ";"");RASTGELEARADA(7;13);1)&PARÇAAL(YERİNEKOY(D2;" ";"");RASTGELEARADA(7;13);1)&" "&PARÇAAL(YERİNEKOY(D2;" ";"");RASTGELEARADA(7;13);1)&PARÇAAL(YERİNEKOY(D2;" ";"");RASTGELEARADA(7;13);1)&" "&PARÇAAL(YERİNEKOY(D2;" ";"");RASTGELEARADA(7;13);1)&PARÇAAL(YERİNEKOY(D2;" ";"");RASTGELEARADA(7;13);1)
Aynı rakamlar rastgele kullanılarak yeni numara üretir.
Kod:=SOLDAN(D2;7)&PARÇAAL(YERİNEKOY(D2;" ";"");RASTGELEARADA(7;13);1)&PARÇAAL(YERİNEKOY(D2;" ";"");RASTGELEARADA(7;13);1)&PARÇAAL(YERİNEKOY(D2;" ";"");RASTGELEARADA(7;13);1)&" "&PARÇAAL(YERİNEKOY(D2;" ";"");RASTGELEARADA(7;13);1)&PARÇAAL(YERİNEKOY(D2;" ";"");RASTGELEARADA(7;13);1)&" "&PARÇAAL(YERİNEKOY(D2;" ";"");RASTGELEARADA(7;13);1)&PARÇAAL(YERİNEKOY(D2;" ";"");RASTGELEARADA(7;13);1)
=KARIŞIM(D2)
Function KARIŞIM(hcr)
aln = Left(hcr, 6)
tel = Replace(Replace(hcr, aln, ""), " ", "")
Dim nmr(1 To 7)
For a = 1 To 7
nmr(a) = Mid(tel, a, 1)
Next
1
t1 = nmr(WorksheetFunction.RandBetween(1, 7)) & nmr(WorksheetFunction.RandBetween(1, 7)) & nmr(WorksheetFunction.RandBetween(1, 7))
If t1 < 100 Then GoTo 1
2
t2 = nmr(WorksheetFunction.RandBetween(1, 7)) & nmr(WorksheetFunction.RandBetween(1, 7))
If t2 = 0 Then GoTo 2
3
t3 = nmr(WorksheetFunction.RandBetween(1, 7)) & nmr(WorksheetFunction.RandBetween(1, 7))
If t3 = 0 Then GoTo 3
KARIŞIM = aln & " " & t1 & " " & t2 & " " & t3
End Function
Aşağıdaki KTF yi deneyiniz.
Kodu boş bir modüle kopyalayıp hücreyeformülünü yazınız.Kod:=KARIŞIM(D2)
Kullanıcı Tanımlı Fonksiyon:
Kod:Function KARIŞIM(hcr) aln = Left(hcr, 6) tel = Replace(Replace(hcr, aln, ""), " ", "") Dim nmr(1 To 7) For a = 1 To 7 nmr(a) = Mid(tel, a, 1) Next 1 t1 = nmr(WorksheetFunction.RandBetween(1, 7)) & nmr(WorksheetFunction.RandBetween(1, 7)) & nmr(WorksheetFunction.RandBetween(1, 7)) If t1 < 100 Then GoTo 1 2 t2 = nmr(WorksheetFunction.RandBetween(1, 7)) & nmr(WorksheetFunction.RandBetween(1, 7)) If t2 = 0 Then GoTo 2 3 t3 = nmr(WorksheetFunction.RandBetween(1, 7)) & nmr(WorksheetFunction.RandBetween(1, 7)) If t3 = 0 Then GoTo 3 KARIŞIM = aln & " " & t1 & " " & t2 & " " & t3 End Function
Sorunuz çok ilginç geldi.Neden istediğinizi merak ettim.
Sorunuz çok ilginç geldi.Neden istediğinizi merak ettim.
Kısaca söylemek gerekirse kendimiz vba kullanarak özel formül oluşturuyoruz.
Bu linkte konuyla ilgili birşeyler var: http://www.yazilimmutfagi.com/10255/ms-office/excel/excelde-kullanici-tanimli-fonksiyonlar-udf-user-defined-functions-.aspx
Detay için inceleyebilirsiniz.
Bu linkte de dosya üzerinde uygulanmış hali var. Alt+F11 tuş kombinasyonuyla kodları görebilirsiniz.
Dosyanız: http://s4.dosya.tc/server/fD0Kgc/Kar__t_r.xls.html
Sayın kuvari kanaatim o ki; bir çağrı merkezinde kullanmak üzere telefon
listesi oluşturulacak, makina otomatik hepsini arayacak ve pazarlama
reklamı dinletecek. Bir bakmışsınız biz de aranmışız.