• DİKKAT

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

comboboxtan comboboxa veri aktarma

  • Konbuyu başlatan Konbuyu başlatan zfr10
  • Başlangıç tarihi Başlangıç tarihi
Z

zfr10

Katılım
5 Şubat 2010
Mesajlar
193
Excel Vers. ve Dili
EXCEL/2016
selam arkadaşlar çalışma sayfamdaki combobox comboboxa veri aktarmak istiyorum açıklama çalışma sayfam içindedir.yardımcı olursanız sevinirim.Saygılar...
 

Ekli dosyalar

zfr10' Alıntı:
selam arkadaşlar çalışma sayfamdaki combobox comboboxa veri aktarmak istiyorum açıklama çalışma sayfam içindedir.yardımcı olursanız sevinirim.Saygılar...
Genişletmek için tıkla ...

merhaba
userform'un kod bölümüne
Kod: 
Option Explicit
Private Sub ComboBox1_Change()
Dim ts As Long, kaplan As New Collection, trabzonspor As Range
If ComboBox1.ListIndex < 0 Then Exit Sub
On Error Resume Next
For ts = 2 To Range("A65536").End(xlUp).Row
If Cells(ts, "A") = ComboBox1.Value Then
kaplan.Add Cells(ts, "B"), CStr(Cells(ts, "B"))
End If
Next
ComboBox2.Clear
ComboBox3.Clear
ComboBox4.Clear
ComboBox5.Clear
For Each trabzonspor In kaplan
ComboBox2.AddItem trabzonspor
Next
End Sub
Private Sub ComboBox2_Change()
Dim ts As Long, kaplan As New Collection, trabzonspor As Range
If ComboBox1.ListIndex < 0 Then Exit Sub
On Error Resume Next
For ts = 2 To Range("A65536").End(xlUp).Row
If Cells(ts, "A") = ComboBox1.Value And _
Cells(ts, "B") = ComboBox2.Value Then
kaplan.Add Cells(ts, "C"), CStr(Cells(ts, "C"))
End If
Next
ComboBox3.Clear
For Each trabzonspor In kaplan
ComboBox3.AddItem trabzonspor
Next
End Sub
Private Sub ComboBox3_Change()
Dim ts As Long, kaplan As New Collection, trabzonspor As Range
If ComboBox1.ListIndex < 0 Then Exit Sub
On Error Resume Next
For ts = 2 To Range("A65536").End(xlUp).Row
If Cells(ts, "A") = ComboBox1.Value And _
Cells(ts, "B") = ComboBox2.Value And _
Cells(ts, "C") = ComboBox3.Value Then
kaplan.Add Cells(ts, "D"), CStr(Cells(ts, "D"))
End If
Next
ComboBox4.Clear
For Each trabzonspor In kaplan
ComboBox4.AddItem trabzonspor
Next
End Sub
Private Sub ComboBox4_Change()
Dim ts As Long, kaplan As New Collection, trabzonspor As Range
If ComboBox1.ListIndex < 0 Then Exit Sub
On Error Resume Next
For ts = 2 To Range("A65536").End(xlUp).Row
If Cells(ts, "A") = ComboBox1.Value And _
Cells(ts, "B") = ComboBox2.Value And _
Cells(ts, "C") = ComboBox3.Value And _
Cells(ts, "D") = ComboBox4.Value Then
kaplan.Add Cells(ts, "E"), CStr(Cells(ts, "E"))
End If
Next
ComboBox5.Clear
For Each trabzonspor In kaplan
ComboBox5.AddItem trabzonspor
Next
End Sub
Private Sub UserForm_Initialize()
Dim ts
For ts = 2 To Range("A65536").End(xlUp).Row
If WorksheetFunction.CountIf(Range("A2:A" & ts), Cells(ts, "A")) = 1 Then
ComboBox1.AddItem Cells(ts, "A")
End If
Next
End Sub
bu kod'u kopyalayın ve deneyin.
 
yardımın için teşekkür ederim yalnız userformsayfa2 de olursa nasıl olur
 
zfr10' Alıntı:
yardımın için teşekkür ederim yalnız userformsayfa2 de olursa nasıl olur
Genişletmek için tıkla ...

sorularınızı taksit taksit sormak işinize geliyor sanırım
bu kodu deneyin
Kod: 
Option Explicit
Private Sub ComboBox1_Change()
Dim ts As Long, kaplan As New Collection, trabzonspor As Range
If ComboBox1.ListIndex < 0 Then Exit Sub
On Error Resume Next
For ts = 2 To Sheets("Sayfa1").Range("A65536").End(xlUp).Row
If Sheets("Sayfa1").Cells(ts, "A") = ComboBox1.Value Then
kaplan.Add Sheets("Sayfa1").Cells(ts, "B"), _
CStr(Sheets("Sayfa1").Cells(ts, "B"))
End If
Next
ComboBox2.Clear
ComboBox3.Clear
ComboBox4.Clear
ComboBox5.Clear
For Each trabzonspor In kaplan
ComboBox2.AddItem trabzonspor
Next
End Sub
Private Sub ComboBox2_Change()
Dim ts As Long, kaplan As New Collection, trabzonspor As Range
If ComboBox1.ListIndex < 0 Then Exit Sub
On Error Resume Next
For ts = 2 To Sheets("Sayfa1").Range("A65536").End(xlUp).Row
If Sheets("Sayfa1").Cells(ts, "A") = ComboBox1.Value And _
Sheets("Sayfa1").Cells(ts, "B") = ComboBox2.Value Then
kaplan.Add Sheets("Sayfa1").Cells(ts, "C"), _
CStr(Sheets("Sayfa1").Cells(ts, "C"))
End If
Next
ComboBox3.Clear
For Each trabzonspor In kaplan
ComboBox3.AddItem trabzonspor
Next
End Sub
Private Sub ComboBox3_Change()
Dim ts As Long, kaplan As New Collection, trabzonspor As Range
If ComboBox1.ListIndex < 0 Then Exit Sub
On Error Resume Next
For ts = 2 To Sheets("Sayfa1").Range("A65536").End(xlUp).Row
If Sheets("Sayfa1").Cells(ts, "A") = ComboBox1.Value And _
Sheets("Sayfa1").Cells(ts, "B") = ComboBox2.Value And _
Sheets("Sayfa1").Cells(ts, "C") = ComboBox3.Value Then
kaplan.Add Sheets("Sayfa1").Cells(ts, "D"), _
CStr(Sheets("Sayfa1").Cells(ts, "D"))
End If
Next
ComboBox4.Clear
For Each trabzonspor In kaplan
ComboBox4.AddItem trabzonspor
Next
End Sub
Private Sub ComboBox4_Change()
Dim ts As Long, kaplan As New Collection, trabzonspor As Range
If ComboBox1.ListIndex < 0 Then Exit Sub
On Error Resume Next
For ts = 2 To Sheets("Sayfa1").Range("A65536").End(xlUp).Row
If Sheets("Sayfa1").Cells(ts, "A") = ComboBox1.Value And _
Sheets("Sayfa1").Cells(ts, "B") = ComboBox2.Value And _
Sheets("Sayfa1").Cells(ts, "C") = ComboBox3.Value And _
Sheets("Sayfa1").Cells(ts, "D") = ComboBox4.Value Then
kaplan.Add Sheets("Sayfa1").Cells(ts, "E"), _
CStr(Sheets("Sayfa1").Cells(ts, "E"))
End If
Next
ComboBox5.Clear
For Each trabzonspor In kaplan
ComboBox5.AddItem trabzonspor
Next
End Sub
Private Sub UserForm_Initialize()
Dim ts
For ts = 2 To Sheets("Sayfa1").Range("A65536").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("Sayfa1").Range("A2:A" & ts), _
Sheets("Sayfa1").Cells(ts, "A")) = 1 Then
ComboBox1.AddItem Sheets("Sayfa1").Cells(ts, "A")
End If
Next
End Sub
 
Combobox1 deki veriyi 1 çırpıda combobox2'ye aktarır.:cool:
Kod: 
ComboBox2.Clear
If ComboBox1.ListCount > 0 Then ComboBox2.List = ComboBox1.List
 
Evren Gizlen' Alıntı:
Combobox1 deki veriyi 1 çırpıda combobox2'ye aktarır.:cool:
Kod: 
ComboBox2.Clear
If ComboBox1.ListCount > 0 Then ComboBox2.List = ComboBox1.List
Genişletmek için tıkla ...


Başlık "comboboxtan comboboxa veri aktarma" olursa Evren beyin yanıtı doğru yanıt olur :)

Alternatif çözüm, döngüye göre daha hızlı.

Kod: 
Private Sub ComboBox1_Change()
    Dim Deg As Variant, _
        c   As Range, _
        Adr As String, _
        d, _
        s1  As Worksheet
 
    ComboBox2.Clear
    ComboBox3.Clear
    ComboBox4.Clear
    ComboBox5.Clear
 
    Set s1 = Sheets("Sayfa1")
    Set d = CreateObject("Scripting.Dictionary")
    With s1.Range("A:A")
        Set c = .Find(ComboBox1.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
 
                Deg = s1.Cells(c.Row, "B")
                If Not d.exists(Deg) Then
                    d.Add Deg, vbNull
                    ComboBox2.AddItem Deg
                End If
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
 
    Set s1 = Nothing
    Set d = Nothing
End Sub


Kod: 
Private Sub ComboBox2_Change()
    Dim Deg As Variant, _
        c   As Range, _
        Adr As String, _
        d, _
        s1  As Worksheet
 
    ComboBox3.Clear
    ComboBox4.Clear
    ComboBox5.Clear
 
    Set s1 = Sheets("Sayfa1")
    Set d = CreateObject("Scripting.Dictionary")
    With s1.Range("B:B")
        Set c = .Find(ComboBox2.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
 
                Deg = s1.Cells(c.Row, "C")
                If Not d.exists(Deg) Then
                    d.Add Deg, vbNull
                    ComboBox3.AddItem Deg
                End If
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
 
    Set s1 = Nothing
    Set d = Nothing
End Sub


Kod: 
Private Sub ComboBox3_Change()
    Dim Deg As Variant, _
        c   As Range, _
        Adr As String, _
        d, _
        s1  As Worksheet
 
    ComboBox4.Clear
    Combobox5.Clear
 
    Set s1 = Sheets("Sayfa1")
    Set d = CreateObject("Scripting.Dictionary")
    With s1.Range("C:C")
        Set c = .Find(ComboBox3.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
 
                Deg = s1.Cells(c.Row, "D")
                If Not d.exists(Deg) Then
                    d.Add Deg, vbNull
                    ComboBox4.AddItem Deg
                End If
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
 
    Set s1 = Nothing
    Set d = Nothing
End Sub

Kod: 
Private Sub ComboBox4_Change()
    Dim Deg As Variant, _
        c   As Range, _
        Adr As String, _
        d, _
        s1  As Worksheet
 
    ComboBox5.Clear
 
    Set s1 = Sheets("Sayfa1")
    Set d = CreateObject("Scripting.Dictionary")
    With s1.Range("D:D")
        Set c = .Find(ComboBox4.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
 
                Deg = s1.Cells(c.Row, "E")
                If Not d.exists(Deg) Then
                    d.Add Deg, vbNull
                    ComboBox5.AddItem Deg
                End If
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
 
    Set s1 = Nothing
    Set d = Nothing
End Sub

Kod: 
Private Sub UserForm_Initialize()
    Dim d, _
        i   As Long, _
        Deg As Variant, _
        s1  As Worksheet
 
    Set s1 = Sheets("Sayfa1")
    Set d = CreateObject("Scripting.Dictionary")
 
    For i = 2 To s1.Cells(Rows.Count, "A").End(3).Row
        Deg = Cells(i, "A")
        If Not d.exists(Deg) Then
            d.Add Deg, vbNull
            ComboBox1.AddItem Deg
        End If
    Next i
    Set s1 = Nothing
    Set d = Nothing
 
End Sub
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst