Aralıktaki Hücreler Boş Değilse

A

AlpGD

Katılım
24 Haziran 2006
Mesajlar
39
Merhaba bir userform üzerinden kayıt yaptırmak istiyorum;

Kod: 
Private Sub Kaydet_Click()

If ComboBox1.Value = "" Then
    MsgBox "Lütfen İşlem Ayını Seçiniz!"
    Exit Sub
End If


If OptionButton1 = True Then Range("f3").Select
If OptionButton2 = True Then Range("p3").Select
If OptionButton3 = True Then Range("z3").Select
If OptionButton4 = True Then Range("aj3").Select
If (OptionButton1 = False) = (OptionButton2 = False) = (OptionButton3 = False) = (OptionButton4 = False) Then MsgBox "olmadi leyn"


For y = 1 To 62
    
ActiveCell.Offset(0 + y, 0) = Controls("Grs1K" & y)
ActiveCell.Offset(0 + y, 1) = Controls("Grs2K" & y)
ActiveCell.Offset(0 + y, 2) = Controls("Cks1K" & y)
ActiveCell.Offset(0 + y, 3) = Controls("Cks2K" & y)
ActiveCell.Offset(0 + y, 4) = Controls("Tplm1K" & y)
ActiveCell.Offset(0 + y, 5) = Controls("Tplm2K" & y)
ActiveCell.Offset(0 + y, 6) = Controls("Sym1K" & y)
ActiveCell.Offset(0 + y, 7) = Controls("Sym2K" & y)
ActiveCell.Offset(0 + y, 8) = Controls("AF1K" & y)
ActiveCell.Offset(0 + y, 9) = Controls("AF2K" & y)
Next y

End Sub
Buradaki sorun mesela optionbutton1 seçili ise range("f4:eek:60") aralığında herhangi bir hücrede bir değer var ise uyarı mesajı vermesi ve cevap evet ise kayıt işlemine devam etmeyi sağlamasını yapamamam.

Kod: 
Private Sub Kaydet_Click()



If ComboBox1.Value = "" Then
    MsgBox "Lütfen İşlem Ayını Seçiniz!"
    Exit Sub
End If


If OptionButton1 = True Then
Range("f3").Select
Dim aras As Range
Set aras = Range("f4:o60").Cells
End If
If OptionButton2 = True Then Range("p3").Select
If OptionButton3 = True Then Range("z3").Select
If OptionButton4 = True Then Range("aj3").Select
If (OptionButton1 = False) = (OptionButton2 = False) = (OptionButton3 = False) = (OptionButton4 = False) Then MsgBox "olmadi leyn"





If Range("f4:o60").cell = "" Then
    cevap = MsgBox("seçtiğiniz boş değil", vbYesNo)
    If cevap = 7 Then Exit Sub
    If cevap = 6 Then Call Kyt
End If


End Sub

Sub Kyt()
For y = 1 To 62
    
ActiveCell.Offset(0 + y, 0) = Controls("Grs1K" & y)
ActiveCell.Offset(0 + y, 1) = Controls("Grs2K" & y)
ActiveCell.Offset(0 + y, 2) = Controls("Cks1K" & y)
ActiveCell.Offset(0 + y, 3) = Controls("Cks2K" & y)
ActiveCell.Offset(0 + y, 4) = Controls("Tplm1K" & y)
ActiveCell.Offset(0 + y, 5) = Controls("Tplm2K" & y)
ActiveCell.Offset(0 + y, 6) = Controls("Sym1K" & y)
ActiveCell.Offset(0 + y, 7) = Controls("Sym2K" & y)
ActiveCell.Offset(0 + y, 8) = Controls("AF1K" & y)
ActiveCell.Offset(0 + y, 9) = Controls("AF2K" & y)
Next y

End Sub


For y = 1 To 62
    
ActiveCell.Offset(0 + y, 0) = Controls("Grs1K" & y)
ActiveCell.Offset(0 + y, 1) = Controls("Grs2K" & y)
ActiveCell.Offset(0 + y, 2) = Controls("Cks1K" & y)
ActiveCell.Offset(0 + y, 3) = Controls("Cks2K" & y)
ActiveCell.Offset(0 + y, 4) = Controls("Tplm1K" & y)
ActiveCell.Offset(0 + y, 5) = Controls("Tplm2K" & y)
ActiveCell.Offset(0 + y, 6) = Controls("Sym1K" & y)
ActiveCell.Offset(0 + y, 7) = Controls("Sym2K" & y)
ActiveCell.Offset(0 + y, 8) = Controls("AF1K" & y)
ActiveCell.Offset(0 + y, 9) = Controls("AF2K" & y)
Next y

End Sub
gibi veya farklı ifadelerle kullanmama rağmen olmadı. yardımcı olursanız sevinirim.
 
N

N.Ziya Hiçdurmaz

Özel Üye
Katılım
28 Nisan 2007
Mesajlar
2,218
Excel Vers. ve Dili
Office 2013 TR / 32 Bit
Private Sub CommandButton1_Click()
Do While OptionButton1 = True
For Each bak In Range("f4:f60")
If bak <> "" Then
If MsgBox("&#304;lgili alanda dolu h&#252;cre mevcut", vbYesNo) = vbYes Then
Exit Sub
End If
End If
Next
Exit Do
Loop
'kodlar&#305;n&#305;z&#305; devam&#305;
End Sub
 
A

AlpGD

Katılım
24 Haziran 2006
Mesajlar
39
Syn. V.Basic For Applications verdi&#287;iniz kodu uygulad&#305;m &#231;al&#305;&#351;t&#305; fakat her dolu h&#252;cre i&#231;in soruyu tekrar tekrar sormakta halbuki ben e&#287;er alan dolu ise sadece bir kez sormas&#305;n&#305; istiyorum.

bir de kodu &#351;u &#351;ekilde uygulad&#305;m;

Kod: 
Private Sub Kaydet_Click()
 
If ComboBox1.Value = "" Then
    MsgBox "L&#252;tfen &#304;&#351;lem Ay&#305;n&#305; Se&#231;iniz!"
    Exit Sub
End If
 
For Each bak In Range("f4:o60")
    If bak <> "" Then
        If MsgBox("&#304;lgili alanda dolu h&#252;cre mevcut", vbYesNo) = vbNo Then
        Exit Sub
        End If
    End If
Next
 
If OptionButton1 = True Then Range("f3").Select
If OptionButton2 = True Then Range("p3").Select
If OptionButton3 = True Then Range("z3").Select
If OptionButton4 = True Then Range("aj3").Select
 
If (OptionButton1 = False) = (OptionButton2 = False) = (OptionButton3 = False) = (OptionButton4 = False) Then
MsgBox "L&#252;tfen Hafta Se&#231;iniz !"
Exit Sub
End If
 
 
 
 
For y = 1 To 62
 
ActiveCell.Offset(0 + y, 0) = Controls("Grs1K" & y)
ActiveCell.Offset(0 + y, 1) = Controls("Grs2K" & y)
ActiveCell.Offset(0 + y, 2) = Controls("Cks1K" & y)
ActiveCell.Offset(0 + y, 3) = Controls("Cks2K" & y)
ActiveCell.Offset(0 + y, 4) = Controls("Tplm1K" & y)
ActiveCell.Offset(0 + y, 5) = Controls("Tplm2K" & y)
ActiveCell.Offset(0 + y, 6) = Controls("Sym1K" & y)
ActiveCell.Offset(0 + y, 7) = Controls("Sym2K" & y)
ActiveCell.Offset(0 + y, 8) = Controls("AF1K" & y)
ActiveCell.Offset(0 + y, 9) = Controls("AF2K" & y)
Next y
 
 
End Sub
verdi&#287;iniz koddan sonra gelen komut ile f3 h&#252;cresini se&#231;mesi gerekirken f35 h&#252;cresini se&#231;ip i&#351;leme &#246;yle devam etmekte, bunun nedenini de anlayamad&#305;m.

ilginiz ve cevab&#305;n&#305;z i&#231;in &#231;ok te&#351;ekk&#252;r ederim.
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Üst