Köprüyü otomatik yapmak.

Cihan SK · 13 Mart 2017

Arkadaşlar,

Mevcut dosyamda bulunan köprüyü ("git") otomatik hale getirmek mümkün mü
değiştir butonuna bastığımda otomatik ilgili satıra gitmesini istiyorum.

Yardımcı olan arkadaşlara şimdiden çok teşekkürler :mutlu::mutlu:

Ömer · 13 Mart 2017

Merhaba,

Bu şekilde deneyin.

Kod:

Sub Sayac()
    
    Dim s As Long
    
    If WorksheetFunction.CountIf([A:A], [K1]) = 0 Then
        MsgBox "Veriyi Bulamadım"
        Exit Sub
    End If
    
    s = WorksheetFunction.Match([K1], [A:A], 0)
    
    Cells(s, "B").Select
    
End Sub

.

Cihan SK · 13 Mart 2017

Ömer bey,
Siz harikasınız.

Kod:

Sub Sayac1()
[K1] = Int((90 * Rnd) + 1)
    Dim s As Long
    
    s = WorksheetFunction.Match([K1], [A:A], 0)
    
    Cells(s, "B").Select
    
End Sub

Ömer · 13 Mart 2017

Kod:

   If WorksheetFunction.CountIf([A:A], [K1]) = 0 Then
        MsgBox "Veriyi Bulamadım"
        Exit Sub
    End If

İlavesini yapmıştım. Eklemenizde fayda var.

.

Cihan SK · 13 Mart 2017

Ömer' Alıntı:
Kod:

If WorksheetFunction.CountIf([A:A], [K1]) = 0 Then MsgBox "Veriyi Bulamadım" Exit Sub End If

İlavesini yapmıştım. Eklemenizde fayda var.

.

Çok teşekkürler

askm · 13 Mart 2017

Kod kısmına aşağıdaki kodları ekleyin.

Kod:

Option Explicit

Sub ASKM_Bul()
Dim Sayfa As Worksheet, Aranan_Veri As Variant
Dim Bul As Range, Adres As String
Aranan_Veri = Range("I1")

For Each Sayfa In Worksheets
Set Bul = Sayfa.Range("B:B").Find(Aranan_Veri, LookAt:=xlWhole)
If Not Bul Is Nothing Then
    Adres = Bul.Address
    Sayfa.Range(Adres).Select
End If
Next
End Sub

Cihan SK · 18 Mart 2017

Kod:

[K1] = Int((90 * Rnd) + 1)

1 - 90 arasındaki rakamları karışık tekrarlıyor. Ancak ben benim belirlediğim alan örneğin: 20 ila 30 veya 150 - 170 ya da 1000 ila 1050 arasındaki rakamları " Hepsi tekrar etmeden " atıyorum 10 rakamın tamamı tekrar etmeden yenisine geçmemesi için ne yapmalıyım. hepsinde 1 tekrar yapacak sonra yine baştan karışık bu şekilde tekrarlama yapmaya çalışıyorum. Sitede ve internet ortamında aradım. çok fazla bilgi kirliliği var.

Ömer · 18 Mart 2017

Linki incelemenizi tavsiye ederim. Konu detaylı bir şekilde işlenmiş.

http://www.excel.web.tr/f142/rastgele-sayy-retme-t58558.html

.

Cihan SK · 20 Mart 2017

Sorduğum soruyu askm arkadaşımızın kodu ile birleştirdim çalışıyor. Teşekkürler Askm ve Ömer Bey.

Kod:

Sub xxx()
[E2] = Evaluate("=RANDBETWEEN(1,100)")
Dim Sayfa As Worksheet, Aranan_Veri As Variant
Dim Bul As Range, Adres As String
Aranan_Veri = Range("C2")

For Each Sayfa In Worksheets
Set Bul = Sayfa.Range("B:B").Find(Aranan_Veri, LookAt:=xlWhole)
If Not Bul Is Nothing Then
    Adres = Bul.Address
    Sayfa.Range(Adres).Select
End If
Next
End Sub

Cihan SK · 20 Mart 2017

Son olarak tekrarsız sayı nasıl yapacağım. mesela 1,10 arasını seçiyorum. 20 kere butona bastığımda 1 hücre 5 tekrar yapmış 1 tanesi hiç tekrar yapmamış.

yani şöyle olursa 1,10 karışık getirsin ama 1,10 en az 1 tekrar olmadıkça 2'inci tekrara başlamamalı

Bende araştırıyorum. Yardımcı olacak tüm arkadaşlara teşekkür ediyorum.

askm · 20 Mart 2017

Rastgele sayı ürettiğiniz verilerinizi başka bir sutuna kaydettirin. Örneğin AA1 sütununa. Countif ile burdaki sayı 1 den büyük ise tekrar sayı üretsin. Sonucu AA1 den itibaren kaydetsin. İlk tuşa bastığınızda AA1, sonra AA2 gibi eğer toplan satır sayısı 10 olmuşsa AA sütununu temizlesin. Yada örneğinizi ekleyin. Bakalım.İlk örneğiniz ile son yazdığınız kodlar pek uyuşmuyor.

Cihan SK · 20 Mart 2017

askm' Alıntı:
Rastgele sayı ürettiğiniz verilerinizi başka bir sutuna kaydettirin. Örneğin AA1 sütununa. Countif ile burdaki sayı 1 den büyük ise tekrar sayı üretsin. Sonucu AA1 den itibaren kaydetsin. İlk tuşa bastığınızda AA1, sonra AA2 gibi eğer toplan satır sayısı 10 olmuşsa AA sütununu temizlesin. Yada örneğinizi ekleyin. Bakalım.İlk örneğiniz ile son yazdığınız kodlar pek uyuşmuyor.

Dosya değişti. Yeni halini ekledim

şöyle ki şimdi ben rastgelearada formülünü kullandım. Aralık (1,10) dedim. ( Bu aralık 1-1000 /1-100 olabilirdi. ) bu şimdi 1-10 arasında tekrar ediyor. ben kaç tane tekrar ettiğini biliyorum. ancak tekrarlama işlemini yaparken kimisini 10 tekrar ediyor kimisini 1 tekrar ediyor. Bende diyorum ki (1,10) arasını en az bir kere tekrar etmeden yeni tekrara başlamasın. (1,10) hepsini bir karışık tekrar yapsın sonra yeni tekrar başlasın. Bu şekilde yapmaya çalışıyordum.

Mevcut kodlara ekleme yapılabilir diye düşünüyorum. Ömer bey'in verdiği linkten bakıyorum.

askm · 20 Mart 2017

Aşağıdaki kodları deneyin. Tuşa da bu kodları atayın.

Kod:

Sub ASKM_Kelime_Getir()
Dim BasRndSayi, BitRndSayi As Long
BasRndSayi = 1
BitRndSayi = 100
SonSatir = Cells(65536, "T").End(xlUp).Row + 1
If SonSatir >= BitRndSayi Then
    Range("T1:T" & SonSatir).ClearContents
End If
'[E2] = Evaluate("=RANDBETWEEN(1,10)")
Dim rastgelesayim As Integer
10:
rastgelesayim = Int((BitRndSayi * Rnd) + BasRndSayi)
Cells(SonSatir, "T") = rastgelesayim
If WorksheetFunction.CountIf(Range("T1:T" & SonSatir), rastgelesayim) > 1 Then
    GoTo 10
Else
    [e2] = rastgelesayim
End If
Dim Sayfa As Worksheet, Aranan_Veri As Variant
Dim Bul As Range, Adres As String
Aranan_Veri = Range("C2")

For Each Sayfa In Worksheets
Set Bul = Sayfa.Range("B:B").Find(Aranan_Veri, LookAt:=xlWhole)
If Not Bul Is Nothing Then
    Adres = Bul.Address
    Sayfa.Range(Adres).Select
End If
Next
End Sub

Cihan SK · 20 Mart 2017

askm' Alıntı:

Aşağıdaki kodları deneyin. Tuşa da bu kodları atayın.

Kod:

Sub ASKM_Kelime_Getir()
Dim BasRndSayi, BitRndSayi As Long
BasRndSayi = 1
BitRndSayi = 100
SonSatir = Cells(65536, "T").End(xlUp).Row + 1
If SonSatir >= BitRndSayi Then
    Range("T1:T" & SonSatir).ClearContents
End If
'[E2] = Evaluate("=RANDBETWEEN(1,10)")
Dim rastgelesayim As Integer
10:
rastgelesayim = Int((BitRndSayi * Rnd) + BasRndSayi)
Cells(SonSatir, "T") = rastgelesayim
If WorksheetFunction.CountIf(Range("T1:T" & SonSatir), rastgelesayim) > 1 Then
    GoTo 10
Else
    [e2] = rastgelesayim
End If
Dim Sayfa As Worksheet, Aranan_Veri As Variant
Dim Bul As Range, Adres As String
Aranan_Veri = Range("C2")

For Each Sayfa In Worksheets
Set Bul = Sayfa.Range("B:B").Find(Aranan_Veri, LookAt:=xlWhole)
If Not Bul Is Nothing Then
    Adres = Bul.Address
    Sayfa.Range(Adres).Select
End If
Next
End Sub

kodu kullandım. 100 kez butona bastığımda 1,10 aralığı tekrar sayısı aşağıdaki gibi, bende diyorum ki bir tanesi 13 olurken bir tanesi 4 de kalmasın yani en azından ortalama 100 kez bastığımda herbiri 9-10 arasında tekrar olsun. çünkü her kelime tekrarında siz aynı şeyi tekrar edeceksiniz. var mı bilmiyorum. Eklediğiniz kod çalışıyor. Emeğinize sağlık.

1 ACCOUNTANT EKOUNTINT MUHASEBECİ SAYMAN 12
2 AFRAİD EFREİD KORKMUŞ KORKAN 11
3 AGE EYÇ YAŞ ÇAĞ DEVİR 13
4 AİRPLANE EYIRPLEYN UÇAK 8
5 ALONE ELON YALNIZ TEK BAŞINA KİMSESİZ 11
6 ANGRY ENGRİ KIZGIN ÖFKELİ HIRSLI 13
7 ANİMAL ENİMİL HAYVAN HAYVANSAL 12
8 ANSWER ENSIR CEVAP VERMEK YANIT YANITLAMAK 6
9 ARCHİTECT ARKİTEKT MİMAR YARATICI TASARLAMAK 4
10 ARRİVE ERAYV VARMAK ULAŞMAK GELMEK 11

askm · 20 Mart 2017

Ekteki dosyaya bir bakın.

Cihan SK · 20 Mart 2017

Emeğinize sağlık super ötesi oldu. Yardımlarınız ve emeğiniz için çok teşekkürler. :mutlu::mutlu::mutlu::mutlu::mutlu::mutlu::mutlu:

Cihan SK · 20 Mart 2017

Son verdiğiniz kodlarda bir sıkıntı oldu. aralık 1-10 olduğunda sorun yok. 25-35 ya da 40 -50 aralığı verdiğimizde sorun çıkıyor. ilk belirlenen aralık dışına çıkıldığında sıkıntı yaratıyor. Farklı aralıklara geçiş yapıyor. biraz geciktim. tabloyu detaylı olarak ancak kontrol etme vaktim oldu.

askm · 20 Mart 2017

Kodları aşağıdaki ile değiştirebilir misiniz.

Kod:

Sub ASKM_Kelime_Getir()
Dim BasRndSayi, BitRndSayi, SonucRndSayi As Long
BasRndSayi = 25
BitRndSayi = 35
SonucRndSayi = BitRndSayi - BasRndSayi
SonSatir = Cells(65536, "T").End(xlUp).Row + 1
If SonSatir > (SonucRndSayi + 1) Then
    Range("T1:T" & SonSatir).ClearContents
    SonSatir = 2
End If
'[E2] = Evaluate("=RANDBETWEEN(1,10)")
Dim rastgelesayim As Integer
10:
rastgelesayim = Int((BitRndSayi - BasRndSayi) * Rnd() + BasRndSayi)
'Int((BitRndSayi * Rnd) + BasRndSayi)
Cells(SonSatir, "T") = rastgelesayim
SonSatir2 = Cells(65536, "U").End(xlUp).Row + 1

If WorksheetFunction.CountIf(Range("T1:T" & SonSatir), rastgelesayim) > 1 Then
    GoTo 10
Else
    [e2] = rastgelesayim
    Cells(SonSatir2, "U") = rastgelesayim
End If
Dim Sayfa As Worksheet, Aranan_Veri As Variant
Dim Bul As Range, Adres As String
Aranan_Veri = Range("C2")

For Each Sayfa In Worksheets
Set Bul = Sayfa.Range("B:B").Find(Aranan_Veri, LookAt:=xlWhole)
If Not Bul Is Nothing Then
    Adres = Bul.Address
    Sayfa.Range(Adres).Select
End If
Next
End Sub

Cihan SK · 20 Mart 2017

Tamam ekledim. Kontrol ettim. Ne kadar teşekkür etsem azdır. Harikasınız....

Köprüyü otomatik yapmak.

Cihan SK

Ekli dosyalar

Ömer

Moderatör

Cihan SK

Ömer

Moderatör

Cihan SK

askm

Destek Ekibi

Cihan SK

Ömer

Moderatör

Cihan SK

Cihan SK

askm

Destek Ekibi

Cihan SK

Ekli dosyalar

askm

Destek Ekibi

Cihan SK

askm

Destek Ekibi

Ekli dosyalar

Cihan SK

Cihan SK

askm

Destek Ekibi

Cihan SK