Belirlenen alana şartlı kayıt

[Erdinç FIRTINA]

Değerli Üyeler;
Yapmak istediğim, belirlenen alanlara şartlı olarak veri aktarmak. Ekteki dosyamda yapmak istediğime ait örnekte açıklama yaptım.

Özetle yapılmak istenen belirli bir sayfada ve sütunda yer alan isimleri Combo ya almak ve Combodaki veriyi (ismi) belirlenen alanlara aktarmak.

Userform2 üzerindeki ComboBox1'e Sayfa 2 deki B sütunundan bir isim seçmek (yani Comboya veri almak) ve Multipage1 (ALAN 1) de bulunan CheckBoxlardan hangileri aktifse, Sayfa1'de tanımlanan alandaki tarih ve saate denk gelen hücreye ComboBox1 ile seçilen veriyi yazdırmak.

Örneğin; ComboBox1 ile sayfa2'den seçilen isim "VELİ" olsun.
ALAN 1'de;
1 - Seçilen CheckBox1 (TARİH 1) ve ComboBox2 de 5 seçilsin, (ALAN 1'de Tarih 1'in bulunduğu satır ile 5 nolu sütunun kesiştiği hücreye "ALİ" yazsın.)
2 - Seçilen CheckBox4 (TARİH 4) ve ComboBox5 de 3 seçilsin, (ALAN 1'de Tarih 4'ün bulunduğu satır ile 3 nolu sütunun kesiştiği hücreye "ALİ" yazsın.)


ALAN 3'te;

1 - Seçilen CheckBox23 (TARİH 3) ve ComboBox24 de 6 seçilsin, (ALAN 3'te Tarih 3'ün bulunduğu satır ile 6 nolu sütunun kesiştiği hücreye "ALİ" yazsın.)
2 - Seçilen CheckBox28 (TARİH 8) ve ComboBox29 da 7 seçilsin, (ALAN 3'te Tarih 8'in bulunduğu satır ile 7 nolu sütunun kesiştiği hücreye "ALİ" yazsın.)

 

[Tarkan VURAL]

Yanıt :

1 -

Private Sub UserForm_Initialize()
Dim i As Long, a As Byte
For i = 2 To Sayfa2.Range("b65536").End(3).Row
ComboBox1.AddItem Sayfa2.Cells(i, 2).Value
Next i
For a = 1 To 10
Me.Controls("TextBox" & a).Value = FormatDateTime(Sayfa1.Cells(a + 6, 1).Value, vbShortDate)
Next a
End Sub

 

[Erdinç FIRTINA]

Sayın Tarkan VURAL,
Yardımlarınız için çok teşekkür ederim ama yapmak istediğim alanlara kayıt yapmıyor.

 

[Tarkan VURAL]

2 -

Private Sub CheckBox1_Click()
Dim bul As Range
If CheckBox1.Value = True Then:
If ComboBox1.Text <> Empty And TextBox11.Text <> Empty Then
For Each bul In Sayfa1.Range("a7:a16")
If bul.Value = FormatDateTime(TextBox1.Value, vbShortDate) Then
bul.Select
End If
Next bul
Select Case TextBox11.Value
    Case Is = 1
        ActiveCell.Offset(0, 1).Value = ComboBox1.Text
    Case Is = 2
        ActiveCell.Offset(0, 2).Value = ComboBox1.Text
    Case Is = 3
        ActiveCell.Offset(0, 3).Value = ComboBox1.Text
    Case Is = 4
        ActiveCell.Offset(0, 4).Value = ComboBox1.Text
    Case Is = 5
        ActiveCell.Offset(0, 5).Value = ComboBox1.Text
    Case Is = 6
        ActiveCell.Offset(0, 6).Value = ComboBox1.Text
    Case Is = 7
        ActiveCell.Offset(0, 7).Value = ComboBox1.Text
    Case Is = 8
        ActiveCell.Offset(0, 8).Value = ComboBox1.Text
End Select
Else
MsgBox "Eksik alanları doldurunuz.", vbExclamation,
End If
End Sub

Diğerleri için geliştirebilirsiniz.