• DİKKAT

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

iki kodu birbirine bağlamak istiyorum

Muhammet Okumuş

Destek Ekibi
Destek Ekibi
Katılım
28 Eylül 2007
Mesajlar
4,042
Excel Vers. ve Dili
2013 Türkçe
*************1.kod********
Sub sayiuretim()
Randomize
If [a9] <> "" Then GoTo 10
While i <= 8 - 1
sayi = Int(8 * Rnd + 1)
If WorksheetFunction.CountIf([a2:a9], sayi) = 0 Then
i = Cells(8 + 1, 1).End(3).Row + 1
Cells(i, 1) = sayi
Exit Sub
End If
Wend
10
If [a17] <> "" Then GoTo 20
While i <= 8 - 1
sayi = Int(8 * Rnd + 1)
If WorksheetFunction.CountIf([a10:a17], sayi) = 0 Then
i = Cells(16 + 1, 1).End(3).Row + 1
Cells(i, 1) = sayi
Exit Sub
End If
Wend
20
If [a25] <> "" Then GoTo 30
While i <= 8 - 1
sayi = Int(8 * Rnd + 1)
If WorksheetFunction.CountIf([a18:a25], sayi) = 0 Then
i = Cells(24 + 1, 1).End(3).Row + 1
Cells(i, 1) = sayi
Exit Sub
End If
Wend
30
If [a33] <> "" Then GoTo 40
While i <= 8 - 1
sayi = Int(8 * Rnd + 1)
If WorksheetFunction.CountIf([a26:a33], sayi) = 0 Then
i = Cells(32 + 1, 1).End(3).Row + 1
Cells(i, 1) = sayi
Exit Sub
End If
Wend
40
End Sub
*************2.kod********
Sub GRUPP()
10 deg = Int(Rnd * [D9].End(3).Row) + 1
If [E9].End(3).Row - 1 = [D9].End(3).Row Then
MsgBox "Tüm isimler çekilmiştir."
Exit Sub
End If
If WorksheetFunction.CountIf([E1:E8], Cells(deg, "D")) = 0 Then
[E9].End(3).Offset(1, 0) = Cells(deg, "D")
[F1] = Cells(deg, "D")
[E1:E8].Sort Key1:=[E1], Order1:=xlAscending
Else
GoTo 10
End If
X = Cells(2, 3).Value
Y = Cells(3, 3).Value
txt = Cells(1, 3)
Cells(X, Y + 7) = txt
End Sub

merhaba arkadaşlar bu iki kodu bir düğmeye atamak istiyorum.düğmeye bastığımda önce 1.kod çalışacak.düğmeye 2.kez bastığımda 2.kod çalışacak.3.kez bastığımda tekrar 1.kod 4.kez bastığımda2.kod çalışacak ve bu şekilde devam edecek.

sub tek ()
call sayı uretim
call Gruppp
end sub

bu şekil yaptım ikisini aynı anda çalıştırıyor.
 
Sn uzmanamele teşekkür ederim ancak sizin kod msgbox şeklinde geliyor.Ben düğmeye bastığım zaman kodların dosya üzerinde işlem yapması gerekiyor
 
Sn uzmanamele teşekkür ederim ancak sizin kod msgbox şeklinde geliyor.Ben düğmeye bastığım zaman kodların dosya üzerinde işlem yapması gerekiyor

Sayın uzmanamele'nin Toggle buton kodlarını:

Kod:
Private Sub ToggleButton1_Click()
If ToggleButton1 Then
ToggleButton1.Caption = "sayiuretim"
Call sayiuretim
Else
ToggleButton1.Caption = "GRUPP"
Call GRUPP
End If
End Sub

şeklinde yapın.

.
 
Geri
Üst