Sayfadaki verileri formata göre Listbox a ADO ile aldırmak.

[C_E_M:)]

Merhaba,
Aşağıdaki kod ile sayfada bulunan verileri Listbox'a alıyorum. Fakat F satırında ki verilerimi Listbox'a sayfadaki format biçimi ile aldırmak istiyorum. F satırında formatlar para birimi olarak bulunuyor. Fakat ben bunları aşağıdaki kolar ile alamıyorum. Yardımcı olacaklara şimdiden teşekkürler.

Private Sub CommandButton1_Click()
Set Con = VBA.CreateObject("adodb.Connection")
md1 = "C:\Belgelerim\Kitap.xlsb"
Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & md1 & ";extended properties=""Excel 12.0;hdr=yes"""
Sorgu = "select * from[Sayfa1$A1:K]"
Set rs = Con.Execute(Sorgu)
ListBox1.ColumnCount = 12
ListBox1.Column = rs.getrows
rs.Close
Set rs = Nothing
Set Con = Nothing
md1 = ""
End Sub

 

[tukayf]

Private Sub CommandButton1_Click()
    Set Con = VBA.CreateObject("adodb.Connection")
    md1 = "C:\Belgelerim\Kitap.xlsb"
    Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & md1 & ";extended properties=""Excel 12.0;hdr=yes"""
    
    Sorgu = "select * from [Sayfa1$A1:K]"
    Set rs = Con.Execute(Sorgu)
    
  
    Dim dataArray As Variant
    dataArray = rs.getrows
    
 
    Dim i As Long
    For i = LBound(dataArray, 2) To UBound(dataArray, 2)
        If IsNumeric(dataArray(5, i)) Then ' 6. sütun (index 5)
            dataArray(5, i) = FormatCurrency(dataArray(5, i))
        End If
    Next i
    
  
    ListBox1.ColumnCount = 12
    ListBox1.Column = dataArray
    
    rs.Close
    Set rs = Nothing
    Set Con = Nothing
    md1 = ""
End Sub

deneyebilir misiniz.

 

[C_E_M:)]

Cevap için teşekkür ederim. Deneme yaptım fakat F satırında para birimlerini ListBox1 de ₺ olarak gösteriyor. $ € olan satırlarda ₺ gösterdi.

 

[tukayf]

Private Sub CommandButton1_Click()
    Dim Con As Object
    Dim rs As Object
    Dim md1 As String
    Dim Sorgu As String
    Dim dataArray As Variant
    Dim i As Long

    Set Con = VBA.CreateObject("adodb.Connection")
    md1 = "C:\Belgelerim\Kitap.xlsb"
    Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & md1 & ";extended properties=""Excel 12.0;hdr=yes"""

    Sorgu = "select * from [Sayfa1$A1:K]"
    Set rs = Con.Execute(Sorgu)

    dataArray = rs.getrows

    For i = LBound(dataArray, 2) To UBound(dataArray, 2)
        If IsNumeric(dataArray(5, i)) Then
            Dim paraBirimi As String
            paraBirimi = Cells(i + 1, 6).NumberFormat

            If InStr(paraBirimi, "₺") > 0 Then
                dataArray(5, i) = Format(dataArray(5, i), "#,##0.00 ₺")
            ElseIf InStr(paraBirimi, "$") > 0 Then
                dataArray(5, i) = Format(dataArray(5, i), "#,##0.00 $")
            ElseIf InStr(paraBirimi, "€") > 0 Then
                dataArray(5, i) = Format(dataArray(5, i), "#,##0.00 €")
            Else
                dataArray(5, i) = Format(dataArray(5, i), "#,##0.00 ₺")
            End If
        End If
    Next i

    ListBox1.ColumnCount = 12
    ListBox1.Column = dataArray

    rs.Close
    Set rs = Nothing
    Set Con = Nothing
    md1 = ""
End Sub

bi dener misiniz hocam. yapay zeka önerdi bu çözümü

 

[C_E_M:)]

Biraz geç oldu denemem. Fakat bu şekilde de olmadı maalesef. tüm rakamların sonlarında ? işareti verdi. Formatı tanımadı. Fakat "₺" işareti benim VB de If InStr(paraBirimi, "?") > 0 Then olarak gözüzüyor. Onu da anlamadım. "₺" yazılmıyor.

 

[C_E_M:)]

Hocam seni de yordum. dataArray = rs.getrows olayından sonra hücre formatını ($, €) tanıması pek de mümkün görünmüyor.
Cells(i + 1, 6) zaten mevcut dosyada işlem yapıyor. "C:\Belgelerim\Kitap.xlsb" dosyasıyla ilgisi yok. Belki sorguda bir şey yapılabilseydi bu mümkün olabilirdi. Fakat bu da benim bildiğim bir konu değil.

 

[Korhan Ayhan]

Merhaba,

ADO verinin biçimiyle ilgilenmez. Bu sebeple sorun yaşıyorsunuz.

Kitap.xlsb isimli dosya harici bir dosya mıdır? Yoksa makroyu kullandığınız dosya mıdır?

 

[C_E_M:)]

Merhaba, Kitap.xlsb kapalı harici bir dosyadır. Bu dosyadan Sayfa1$A1:K] arası olan verileri Listbox1 e alacağım. Bu veriler 5.000 - 10.000 satır arası. F satırında fiyat satırı bulunuyor ve bu fiyatlarda farklı para formatları var. G satırına döviz kuru yazmış olsaydım ADO ile çok hızlı alacaktı ve sorun kalmayacaktı. ADO kadar olmasa da hızlı bir yöntem olursa onu da kullanabilirim.

 

[haliliyas]

Haricî bir siteye örnek dosya eklerseniz yardımcı olmaya çalışırim