excel sayfası üzerindeki ComboBox'a veri alma

[Hacı Bayram ÖZKAN]

Merhaba arkadaşlar; Excel sayfası üzerinde bir ComboBox'um var buna Veri sayfasından veri almak istiyorum.

Private Sub ComboBox1_Change ()
ComboBox1.ListFillRange = "Veri!B3:B18" 
End Sub

Bu kodu denedim olmadı nasıl bir kod yazmalıyım. Herkese teşekkürler.

 

[serkankiyak]

örnek;

Private Sub 
UserForm_Initialize()

ComboBox1.RowSource = ("Sayfa1!b1:b35")

End Sub

 

[Hacı Bayram ÖZKAN]

Merhaba Serkan Bey; Bu ComboBox Userform üzerinde değil, sayfa üzerinde birtek ComboBox bunu şu şekilde sağladım ComboBox özellikler, Properties in ListFillRange hanesine Veri!B2:B100 yazınca oluyor ancak burda boş satırları ve mükerrerleri de alıyor, oysa ben boş satırı almasın ve mükerrerleri tek alsın istiyorum. Teşekkürler.

 

[halit3]

Merhaba arkadaşlar; Excel sayfası üzerinde bir ComboBox'um var buna Veri sayfasından veri almak istiyorum.

Private Sub ComboBox1_Change ()
ComboBox1.ListFillRange = "Veri!B3:B18" 
End Sub

Bu kodu denedim olmadı nasıl bir kod yazmalıyım. Herkese teşekkürler.

yazdığınız kodun hemen altına bu kodu ekleyin

Private Sub Worksheet_Activate()
ComboBox1_Change
End Sub

Bu kod veri sayfasına girişte sizin kodunuzu tetikliyor yanı bir başka sayfadan veri sayfasına girince çalışıyor.

 

[Hacı Bayram ÖZKAN]

Halit Bey şu şekilde yaptım olmadı. Veri sayfasının kod bölümüne;

Private Sub ComboBox1_Change ()
ComboBox1.ListFillRange = "Veri!B3:B18" 
End Sub
Private Sub Worksheet_Activate()
ComboBox1_Change
End Sub

Bu şekil olacak doğrumu eğer doğru ise çalışmadı. Bir bakarmısın.

 

[Hacı Bayram ÖZKAN]

Tamam halit bey işlem yapınca oldu eline sağlık teşekkürler. Dua ile kalın

 

[halit3]

Tamam halit bey işlem yapınca oldu eline sağlık teşekkürler. Dua ile kalın

Kodu bu şekilde yaparsanız daha iyi olur.

Private Sub Worksheet_Activate()
ComboBox1.ListFillRange = "Veri!B3:B18" 
End Sub

sayfaya giriş çıkış yaptıktan sonra kod çalışacaktır.

 

[Hacı Bayram ÖZKAN]

Halit Bey bu kodu mükerrer olanları tek ve Alfabetik nasıl sıralatırız. Bunuda yazarsan sevinirim. Teşekkürler

 

[halit3]

Halit Bey bu kodu mükerrer olanları tek ve Alfabetik nasıl sıralatırız. Bunuda yazarsan sevinirim. Teşekkürler

Benzersiz sıralamak için kod:

Private Sub Worksheet_Activate()
Dim x, j
Set j = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Sheets(ActiveSheet.Name).ComboBox1.Clear
For Each x In [B3:B18]
If x.Value <> "" Then
If Not j.exists(x.Value) Then
j.Add x.Value, Nothing
Sheets(ActiveSheet.Name).ComboBox1.AddItem x.Value
End If
End If
Next x
Application.ScreenUpdating = True

End Sub

Benzersiz ve alfabedik sıralamak için
kod:

Private Sub Worksheet_Activate()
Dim hcr As Range, z As Object, list(), i As Long, j As Long
Sheets(ActiveSheet.Name).ComboBox1.Clear

Set z = CreateObject("Scripting.Dictionary")
ReDim list(1 To 1, 1 To 65536)
For Each hcr In Range("B3:B18")
If hcr.Value <> "" Then

If Not z.exists(hcr.Value) Then
a = a + 1
list(1, a) = hcr.Value
z.Add hcr.Value, Nothing
End If

End If
Next
ReDim Preserve list(1 To 1, 1 To a)

For i = 1 To a - 1
For j = i + 1 To a
If list(1, i) > list(1, j) Then
x = list(1, j)
list(1, j) = list(1, i)
list(1, i) = x
End If
Next j
Next
For i = 1 To a
Sheets(ActiveSheet.Name).ComboBox1.AddItem list(1, i)
Next

End Sub

 

[Hacı Bayram ÖZKAN]

Eline sağlık halit bey iyi günler dua ile kalın.

 

[Hacı Bayram ÖZKAN]

Halit Bey mavi kodun yerine başka bir sayfadan veri almak için kırmızı denedim olmadı ;

Private Sub Worksheet_Activate()
Dim hcr As Range, z As Object, list(), i As Long, j As Long
[COLOR="Blue"]Sheets(ActiveSheet.Name).ComboBox1.Clear[/COLOR]
[COLOR="Red"]Sheets("VERİ").ComboBox1.Clear 'yazdım olmadı[/COLOR]
Set z = CreateObject("Scripting.Dictionary")
ReDim list(1 To 1, 1 To 65536)
For Each hcr In Range("B3:B18")
If hcr.Value <> "" Then

If Not z.exists(hcr.Value) Then
a = a + 1
list(1, a) = hcr.Value
z.Add hcr.Value, Nothing
End If

End If
Next
ReDim Preserve list(1 To 1, 1 To a)

For i = 1 To a - 1
For j = i + 1 To a
If list(1, i) > list(1, j) Then
x = list(1, j)
list(1, j) = list(1, i)
list(1, i) = x
End If
Next j
Next
For i = 1 To a
[COLOR="Blue"]Sheets(ActiveSheet.Name).ComboBox1.AddItem list(1, i)[/COLOR]
[COLOR="Red"]Sheets("VERİ").ComboBox1.Clear [/COLOR]
Next

End Sub

yaptım olmadı neden acaba buna bir bakarmısın iyi günler.

 

[halit3]

Halit Bey mavi kodun yerine başka bir sayfadan veri almak için kırmızı denedim olmadı ;

Private Sub Worksheet_Activate()
Dim hcr As Range, z As Object, list(), i As Long, j As Long
[COLOR="Blue"]Sheets(ActiveSheet.Name).ComboBox1.Clear[/COLOR]
[COLOR="Red"]Sheets("VERİ").ComboBox1.Clear 'yazdım olmadı[/COLOR]
Set z = CreateObject("Scripting.Dictionary")
ReDim list(1 To 1, 1 To 65536)
For Each hcr In Range("B3:B18")
If hcr.Value <> "" Then

If Not z.exists(hcr.Value) Then
a = a + 1
list(1, a) = hcr.Value
z.Add hcr.Value, Nothing
End If

End If
Next
ReDim Preserve list(1 To 1, 1 To a)

For i = 1 To a - 1
For j = i + 1 To a
If list(1, i) > list(1, j) Then
x = list(1, j)
list(1, j) = list(1, i)
list(1, i) = x
End If
Next j
Next
For i = 1 To a
[COLOR="Blue"]Sheets(ActiveSheet.Name).ComboBox1.AddItem list(1, i)[/COLOR]
[COLOR="Red"]Sheets("VERİ").ComboBox1.Clear [/COLOR]
Next

End Sub

yaptım olmadı neden acaba buna bir bakarmısın iyi günler.

For Each hcr In [COLOR="Red"]Range[/COLOR]("B3:B18")

Benim şimdilik gördüğüm bu Range ve Cells yazan yerlerede sayfa adını tanıtmalısın

Sheets("VERİ").Range
Sheets("VERİ").Cells

 

[Hacı Bayram ÖZKAN]

Teşekkürler halit bey iyi günler