Listboxa göre kaydet

[sirkülasyon]

Hayırlı Akşamlar, Hayırlı İftarlar

Ekli dosyamın userform açıldığında
KULLANICI TARAFINDAN
combobox1 de okul seçilecek
Listbox1 de sendika seçilecek
Listbox1 de seçilen sendikanın erkek üye sayısı girilecek
Listbox1 de seçilen sendikanın kadın üye sayısı girilecek
Okul veya Kurumdaki Toplam Erkek Kamu Görevlisi sayısı girilecek
Okul veya Kurumdaki Toplam Kadın Kamu Görevlisi sayısı girilecek

KAYDET butonu ile
combobox1 de seçilen okul "Okullar" sayfasında seçildiği an "A" sütununa "seçildi" yazılarak bir daha seçilmesine izin vermeyecek
Listbox1 de seçilen sendikanın "G" sütununa erkek üye sayısının girildiği TextBox4 ve "H" sütununa da kadın üye sayısının girildiği TextBox5 aktarılacak
Erkek Kamu Görevlisi sayısı TextBox6 İlçe Sayfasında D6 hücresine
Kadın Kamu Görevlisi sayısı TextBox7 İlçe Sayfasında E6 hücresine aktarılacak

Sizlerden ricam yukarıda kaydet butonu ile yapılması gereken işlemleri sağlayacak makro için yardım istirham ediyorum.

 

[Korhan Ayhan]

ComboBox nesnesinin üstüne birde TextBox eklemişsiniz. Ne amaçla eklediğinizi bilmiyorum. Bu sebeple ellemedim.

Aşağıdaki kodları dosyanıza uyarlarsınız.

Hiç bir kontrol kodu eklemedim. Gerekiyorsa kendiniz eklersiniz.

Private Sub ComboBox1_Change()
    TextBox1 = ComboBox1
    If ComboBox1 <> "" Then
        Set Bul = Sheets("Okullar").Range("B:B").Find(ComboBox1, , , xlWhole)
        If Not Bul Is Nothing Then
            If Bul.Offset(, -1) = "" Then
                Bul.Offset(, -1) = "Seçildi"
            Else
                MsgBox "Bu kurum daha önce seçilmiş!" & vbCr & vbCr & "Lütfen başka kurum seçiniz.", vbCritical
                ComboBox1 = ""
            End If
        End If
    End If

    Set Bul = Nothing
End Sub

Private Sub CommandButton1_Click()
    With Sheets("İlçe")
        Set Bul = .Range("C:F").Find(ListBox1.Value, , , xlWhole)
        If Not Bul Is Nothing Then
            Bul.Offset(, 1) = TextBox4 * 1
            Bul.Offset(, 2) = TextBox5 * 1
            .Range("D6") = TextBox6 * 1
            .Range("E6") = TextBox7 * 1
        Else
            MsgBox "Sendika bulunamadı!", vbCritical
        End If
    End With
    
    Set Bul = Nothing
    
    MsgBox "Kayıt işlemi yapılmıştır.", vbInformation
End Sub

UserForm_Activate olayındaki ComboBox1 nesnesine yükleme yapan döngüyü de aşağıdaki gibi değiştiriniz.

  For Each c In sh.Range("b2", sh.Range("b" & Rows.Count).End(xlUp))
    If c.Offset(, -1) <> "Seçildi" Then dic(c.Value) = Empty
  Next

 

[sirkülasyon]

Korhan abi ellerine sağlık. Saygı ve hürmetlerimle teşekkür ederim.
İlçe sayfasında var olan aşağıdaki kod manuel girilince çalışıyor. Form üzerinden aktardığı zaman üst üste toplaması için nasıl değiştirebilirim?

Option Explicit
Dim İLK_VERİ As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [G9:G54,H9:H54]) Is Nothing Then Exit Sub
    If Target = "" Then
        İLK_VERİ = Empty
        Exit Sub
    End If
    If IsNumeric(Target) Then
        Application.EnableEvents = False
        Target = İLK_VERİ + Target
        Application.EnableEvents = True
    End If
     İLK_VERİ = Target
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    İLK_VERİ = Target
End Sub

 

[Korhan Ayhan]

Kodu aşağıdaki gibi değiştirip deneyiniz.

Private Sub CommandButton1_Click()
    With Sheets("İlçe")
        Set Bul = .Range("C:F").Find(ListBox1.Value, , , xlWhole)
        If Not Bul Is Nothing Then
            Bul.Offset(, 1) = Bul.Offset(, 1) + TextBox4 * 1
            Bul.Offset(, 2) = Bul.Offset(, 2) + TextBox5 * 1
            .Range("D6") = TextBox6 * 1
            .Range("E6") = TextBox7 * 1
        Else
            MsgBox "Sendika bulunamadı!", vbCritical
        End If
    End With
    
    Set Bul = Nothing
    
    MsgBox "Kayıt işlemi yapılmıştır.", vbInformation
End Sub

 

[sirkülasyon]

Çok teşekkür ederim. Kadir geceniz mübarek olsun

 

[Korhan Ayhan]

Bilmukabele..