Soru CheckBox ile döngü.

[Hakan ERDOST]

Kullanıcı formu üzerinde yer alan seçime göre 280 adet checkboxtaki verileri Davranış_Takip isimli sayfaya aktarmaya çalışıyorum, işin çoğu halledildi ancak satır başındaki checkbox seçimine bağlı satırdaki ceheckboxların aktarımını döngüye aktaramadım. Şöyleki 20 adet cehckbox satırbaşlarında , örneğin 1.cehckbox true ve 21,41....261 nolu textboxlar true ise sayfaya 1 false ise 0 yazsın. İşaretli tüm satırlardaki veriler aktarılsın. Aslında sözel olarak döngü tamam ) ancak kodlamada

 

[Hakan ERDOST]

Dosyanın son hali ekte, verileri blok olarak değil de ilk boş satırdan itibaren döngüye uygun olarak nasıl aktarabilirm.

 

[Korhan Ayhan]

Deneyiniz.

Private Sub CommandButton1_Click()
    Dim S1 As Worksheet, X As Byte, Y As Integer, Satir As Long, Sutun As Integer
    
    Set S1 = Sheets("Davranış_takip")
    
    Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 1
    Sutun = 5
    
    For X = 1 To 20
        If Me.Controls("CheckBox" & X) = True Then
            S1.Cells(Satir, 1) = Satir - 1
            If TextBox1.Value <> "" Then S1.Cells(Satir, 2) = CDate(TextBox1.Value)
            S1.Cells(Satir, 3) = ComboBox1.Value
            S1.Cells(Satir, 4) = Me.Controls("ad" & X).Caption
                        
            For Y = X + 20 To X + 260 Step 20
                If Me.Controls("CheckBox" & Y) = True Then
                    S1.Cells(Satir, Sutun) = 1
                End If
                Sutun = Sutun + 1
            Next
            Satir = Satir + 1
            Sutun = 5
        End If
    Next
    
    S1.Columns.AutoFit
    
    Set S1 = Nothing
        
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Hakan ERDOST]

Deneyiniz.

Private Sub CommandButton1_Click()
    Dim S1 As Worksheet, X As Byte, Y As Integer, Satir As Long, Sutun As Integer
   
    Set S1 = Sheets("Davranış_takip")
   
    Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 1
    Sutun = 5
   
    For X = 1 To 20
        If Me.Controls("CheckBox" & X) = True Then
            S1.Cells(Satir, 1) = Satir - 1
            If TextBox1.Value <> "" Then S1.Cells(Satir, 2) = CDate(TextBox1.Value)
            S1.Cells(Satir, 3) = ComboBox1.Value
            S1.Cells(Satir, 4) = Me.Controls("ad" & X).Caption
                       
            For Y = X + 20 To X + 260 Step 20
                If Me.Controls("CheckBox" & Y) = True Then
                    S1.Cells(Satir, Sutun) = 1
                End If
                Sutun = Sutun + 1
            Next
            Satir = Satir + 1
            Sutun = 5
        End If
    Next
   
    S1.Columns.AutoFit
   
    Set S1 = Nothing
       
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Teşekkürler Korhan bey.