Comboboxtaki verileri excele yazdırma

[hakanbolat]

Merhaba arkadaşlar, combobox'a veriyi süzerek alıyorum, aldığım verileri rp sayfasına yazdırmaya çalışıyorum,yardımcı olursanız sevinirim.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Private Sub CommandButton1_Click()
 
    Dim Srp As Worksheet, son As Long
    
    If firmalar.Value = "" Then Exit Sub
    
    Set Srp = Sheets("rp")
    son = Srp.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    Srp.Cells(son, "A") = firmalar.Value
    
End Sub

.

 

[hakanbolat]

Teşekkürler, ürünleri comboboxtaki gibi yazdırabilirmiyiz,comboboxta ürünler 5 adet geliyor, 5'nide yazdırabilirmiyiz.

 

[Ömer]

Tüm değerleri yazdıracaksanız ektradan butona gerek yok, form açılırkende yazdırabilirsiniz.

Bu şekilde işinizi görür mü?

 

[hakanbolat]

Butonu bilerek koydum,çünkü bu komuttan sonra diğer komutlar çalışacak, bu şekilde yapabilirseniz memnun olurum.

 

[hakanbolat]

Ömer bey bakabilecekmisiniz..

 

[Ömer]

Eklediğiniz dosyaya göre formdaki tüm kodları silip aşağıdaki kodları ekleyin. Benzersiz verileri almada sizin yazdığınız metoda göre çok daha hızlıdır.

Dim a, d As Object[COLOR=darkgreen] 'genel değişken tanımı[/COLOR]
 
[COLOR=darkgreen]'buton ile rp sayfasına comboboxa alınan değerlerin tümünü yazar[/COLOR]
Private Sub CommandButton1_Click()
 
    Dim Sp As Worksheet, son As Long, i As Long
 
    Set Sp = Sheets("rp")
    son = Sp.Cells(Rows.Count, "A").End(xlUp).Row + 1
 
    For i = 0 To d.Count - 1
        Sp.Cells(son + i, "A") = a(i)
    Next i
 
End Sub
 
[COLOR=darkgreen]'form açılırken comboboxa veriler benzersiz gelir[/COLOR]
Private Sub UserForm_Initialize()
 
  [COLOR=blue]  Benzersizler[/COLOR]
 
    With Me.firmalar
        .Clear
        .List = a
    End With
 
End Sub
 
[COLOR=darkgreen]'e sütunundaki verileri benzersiz diziye alır[/COLOR]
Private Sub [COLOR=blue]Benzersizler[/COLOR]()
 
    Dim Sr As Worksheet, i As Long, deg
 
    Set Sr = Sheets("Rapor")
    Set d = CreateObject("Scripting.Dictionary")
 
    For i = 3 To Sr.Cells(Rows.Count, "D").End(xlUp).Row
        deg = Sr.Cells(i, "D")
        If Not d.exists(deg) Then d.Add deg, Nothing
    Next i
 
    a = d.keys
 
End Sub

.

 

[hakanbolat]

Çok teşekkürler,elinize sağlık..