cem yılmaz
Altın Üye
- Katılım
- 23 Aralık 2006
- Mesajlar
- 359
- Excel Vers. ve Dili
- Office365 TÜRKÇE
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub ComboBox1_Change()
Dim c As Range, _
Adr As String, _
i As Integer, _
Sh As Worksheet
ComboBox2.Clear
Set Sh = Sheets("İL VE İLÇE KODLARI")
Set c = Sh.Range("A:A").Find(ComboBox1.Value, LookIn:=xlValues)
If Not c Is Nothing Then i = c.Row + 1
Do
ComboBox2.AddItem Sh.Cells(i, "A")
i = i + 1
Loop Until Sh.Cells(i, "B") = ""
ComboBox2.SetFocus
End Sub
Private Sub ComboBox2_Change()
TextBox1.Value = ComboBox2.Value
TextBox1.SetFocus
End Sub
Private Sub UserForm_Initialize()
Dim i As Integer, _
c As Range, _
Sh As Worksheet, _
Adr As String
Set Sh = Sheets("İL VE İLÇE KODLARI")
i = Sh.Cells(Rows.Count, "A").End(3).Row
With Sh.Range("B1:B" & i)
Set c = .Find("", LookIn:=xlValues)
If Not c Is Nothing Then
Adr = c.Address
Do
ComboBox1.AddItem Sh.Cells(c.Row, "A")
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
End With
End Sub
[FONT="Arial Narrow"][B]Private Sub UserForm_Initialize()[/B]
ComboBox1.Clear
For satır = 2 To Sheets("İL VE İLÇE KODLARI").[A65536].End(3).Row
[COLOR="Red"]If Sheets("İL VE İLÇE KODLARI").Cells(satır, 1).Font.ColorIndex = 5 Then _[/COLOR]
[COLOR="Blue"]If Sheets("İL VE İLÇE KODLARI").Cells(satır, 2) = "" Then _[/COLOR]
ComboBox1.AddItem Sheets("İL VE İLÇE KODLARI").Cells(satır, 1)
Next
[B]End Sub[/B]
[B]Private Sub ComboBox1_Change()[/B]
TextBox1 = "": ComboBox2.Clear
ilk = WorksheetFunction.Match(ComboBox1.Value, Sheets("İL VE İLÇE KODLARI").[A:A], 0)
For sat = ilk + 1 To Sheets("İL VE İLÇE KODLARI").[A65536].End(3).Row
[COLOR="Red"]If Sheets("İL VE İLÇE KODLARI").Cells(sat, 1).Font.ColorIndex = 5 Then Exit For[/COLOR]
[COLOR="Blue"]If Sheets("İL VE İLÇE KODLARI").Cells(sat, 2) = "" Then Exit For[/COLOR]
ComboBox2.AddItem Sheets("İL VE İLÇE KODLARI").Cells(sat, 1)
Next
[B]End Sub[/B]
[B]Private Sub ComboBox2_Change()[/B]
If ComboBox1 = "" Or ComboBox2 = "" Then
TextBox1 = "": GoTo 10: End If
satt = WorksheetFunction.Match(ComboBox2.Value, Sheets("İL VE İLÇE KODLARI").[A:A], 0)
TextBox1 = Sheets("İL VE İLÇE KODLARI").Cells(satt, 2)
10:
[B]End Sub[/B][/FONT]
Merhaba.
UserForm'un kod bölümüne aşağıdaki kodları yapıştırın.
.Kod:[FONT="Arial Narrow"][B]Private Sub UserForm_Initialize()[/B] ComboBox1.Clear For satır = 2 To Sheets("İL VE İLÇE KODLARI").[A65536].End(3).Row If Sheets("İL VE İLÇE KODLARI").Cells(satır, 1).Font.ColorIndex = 5 Then _ ComboBox1.AddItem Sheets("İL VE İLÇE KODLARI").Cells(satır, 1) Next [B]End Sub[/B] [B]Private Sub ComboBox1_Change()[/B] TextBox1 = "": ComboBox2.Clear ilk = WorksheetFunction.Match(ComboBox1.Value, Sheets("İL VE İLÇE KODLARI").[A:A], 0) For sat = ilk + 1 To Sheets("İL VE İLÇE KODLARI").[A65536].End(3).Row If Sheets("İL VE İLÇE KODLARI").Cells(sat, 1).Font.ColorIndex = 5 Then Exit For ComboBox2.AddItem Sheets("İL VE İLÇE KODLARI").Cells(sat, 1) Next [B]End Sub[/B] [B]Private Sub ComboBox2_Change()[/B] If ComboBox1 = "" Or ComboBox2 = "" Then TextBox1 = "": GoTo 10: End If satt = WorksheetFunction.Match(ComboBox2.Value, Sheets("İL VE İLÇE KODLARI").[A:A], 0) TextBox1 = Sheets("İL VE İLÇE KODLARI").Cells(satt, 2) 10: [B]End Sub[/B][/FONT]
Dim S1 As Worksheet, Son As Long, X As Long, Bul As Range, Satir As Long
Private Sub ComboBox1_Change()
Set Bul = S1.Range("A:A").Find(ComboBox1.Value, , , xlWhole)
If Not Bul Is Nothing Then
For X = Bul.Row + 1 To Bul.Row + 100
If S1.Cells(X, 2) = "" Then Exit For
ComboBox2.AddItem
ComboBox2.List(Satir, 0) = S1.Cells(X, 1).Value
ComboBox2.List(Satir, 1) = S1.Cells(X, 2).Value
Satir = Satir + 1
Next
End If
End Sub
Private Sub ComboBox2_Change()
TextBox1 = ComboBox2.Column(1)
End Sub
Private Sub UserForm_Initialize()
Set S1 = Sheets("İL VE İLÇE KODLARI")
Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
For X = 2 To Son
If S1.Cells(X, 1) <> "" And S1.Cells(X, 2) = "" Then
ComboBox1.AddItem S1.Cells(X, 1)
End If
Next
End Sub
Bende bir şeyler karalamıştım. Alternatif olarak denersiniz.
Kod:Dim S1 As Worksheet, Son As Long, X As Long, Bul As Range, Satir As Long Private Sub ComboBox1_Change() Set Bul = S1.Range("A:A").Find(ComboBox1.Value, , , xlWhole) If Not Bul Is Nothing Then For X = Bul.Row + 1 To Bul.Row + 100 If S1.Cells(X, 2) = "" Then Exit For ComboBox2.AddItem ComboBox2.List(Satir, 0) = S1.Cells(X, 1).Value ComboBox2.List(Satir, 1) = S1.Cells(X, 2).Value Satir = Satir + 1 Next End If End Sub Private Sub ComboBox2_Change() TextBox1 = ComboBox2.Column(1) End Sub Private Sub UserForm_Initialize() Set S1 = Sheets("İL VE İLÇE KODLARI") Son = S1.Cells(S1.Rows.Count, 1).End(3).Row For X = 2 To Son If S1.Cells(X, 1) <> "" And S1.Cells(X, 2) = "" Then ComboBox1.AddItem S1.Cells(X, 1) End If Next End Sub
Teşekkürler fakat ilçe kodunu yazmıyor. İlçe ne seçilmişse onu yazıyor.
Dim S1 As Worksheet, Son As Long, X As Long, Bul As Range
Private Sub ComboBox1_Change()
Set Bul = S1.Range("A:A").Find(ComboBox1.Value, , , xlWhole)
If Not Bul Is Nothing Then
For X = Bul.Row + 1 To Bul.Row + 100
If S1.Cells(X, 2) = "" Then Exit For
ComboBox2.AddItem S1.Cells(X, 1).Value
ComboBox3.AddItem S1.Cells(X, 2).Value
Next
End If
End Sub
İlçe kodunu yazmıyor ne demek?
deneyerek gönderdim kodları. Ve bir şartım vardı onu gerçekleştirmeniz gerekirdi.
3 ComboBox olacaksa aşağıdaki gibi kullanabilirsiniz.
Satir değişkenini kaldırabilirsiniz. Direkt ADDITEM metodu yeterli olacaktır.
Kod:Dim S1 As Worksheet, Son As Long, X As Long, Bul As Range Private Sub ComboBox1_Change() Set Bul = S1.Range("A:A").Find(ComboBox1.Value, , , xlWhole) If Not Bul Is Nothing Then For X = Bul.Row + 1 To Bul.Row + 100 If S1.Cells(X, 2) = "" Then Exit For ComboBox2.AddItem S1.Cells(X, 1).Value ComboBox3.AddItem S1.Cells(X, 2).Value Next End If End Sub
Necdet Bey,
Arkadaşımız TextBox nesnesinde ilçe kodunu görmek istediğini belirtmiş. Sizin verdiğiniz kod direkt olarak ilçe adını yazıyor.