Süzmede,ListBox'taki Format Kayboluyor

[ZorBey_]

Merhaba
İyi Çalışmalar

Süzmede ListBoxta Format Sorunum Var
Süzme Yapmadan Evvel
ListBoxtaki TL Formatı Görünüyor
550,00 TL
365,00 TL
185,00 TL
Olarak Görünüyor
Fakat Süzmede
Örneğin A001 Süzdüğümde
550
365
185
Olarak Görüyor
Bunu 550,00 TL Formatında Görünmesi
İçin Yardımınızı Rica Ediyorum
İyi Çalışmalar.

 

[halit3]

Merhaba
İyi Çalışmalar

Süzmede ListBoxta Format Sorunum Var
Süzme Yapmadan Evvel
ListBoxtaki TL Formatı Görünüyor
550,00 TL
365,00 TL
185,00 TL
Olarak Görünüyor
Fakat Süzmede
Örneğin A001 Süzdüğümde
550
365
185
Olarak Görüyor
Bunu 550,00 TL Formatında Görünmesi
İçin Yardımınızı Rica Ediyorum
İyi Çalışmalar.

Kodunuza aşağıdaki kırmızı bölümü ekledim.

kod:

Private Sub TextBox25_Change() 'VERI ARAMA'
    Dim k As Range, adrs As String, j As Byte, a, sat As Long
    ReDim myarr(0 To 15, 1 To 1) '0 DAN YANİ ASUTUNU SIRA NOLARINI GÖSTERİRİ 15 SON SUTUN SAYISI
    If TextBox25.Text = "" Then
    sat = ActiveSheet.Cells(65536, "A").End(xlUp).Row
    ListBox1.RowSource = ComboBox1.Text & "!A2:O" & sat
    Exit Sub
    End If
    Set s1 = Sheets("" & ComboBox1)
    With s1
        ListBox1.RowSource = ""
        TextBox29 = ""
        TextBox30 = ""
        TextBox31 = ""
        If .FilterMode Then .ShowAllData
        Set k = .Range("A2:O65536").Find(TextBox25.Text & "*", , xlValues, xlWhole)
        If Not k Is Nothing Then
            adrs = k.Address
            Do
                a = a + 1 'ARANAN DAN KAÇ TANE OLURSA OLSUN HEPSİNİ GETİRİR
                'a = a 'ARANAN DAN KAÇ TANE OLURSA OLSUN YALNIZ BİR TANE GETİRİR
                ReDim Preserve myarr(0 To 15, 1 To a) '0 DAN YANİ ASUTUNU SIRA NOLARINI GÖSTERİRİ 15 SON SUTUN SAYISI
                For j = 0 To 15 '0 DAN YANİ ASUTUNU SIRA NOLARINI GÖSTERİRİ 15 SON SUTUN SAYISI
                     
                  [COLOR=red]  If j = 2 Then
                    myarr(j, a) = Format(.Cells(k.Row, j + 1).Value, "dd.mm.yyyy")
                    ElseIf j = 12 Or j = 13 Or j = 14 Then
                    myarr(j, a) = Format(.Cells(k.Row, j + 1).Value, "#,##0.00  TL")
                    Else
                    myarr(j, a) = .Cells(k.Row, j + 1).Value
                    End If
                    'myarr(j, a) = .Cells(k.Row, j + 1).Value
[/COLOR]                    
                    If j = 13 Then alinan_toplam = alinan_toplam + .Cells(k.Row, j).Value
                    If j = 14 Then odenen_toplam = odenen_toplam + .Cells(k.Row, j).Value
                    If j = 15 Then kalan_toplam = kalan_toplam + .Cells(k.Row, j).Value
                Next j
                Set k = s1.Range("A2:O65536").FindNext(k)
            Loop While Not k Is Nothing And k.Address <> adrs
            ListBox1.Column = myarr
            TextBox29 = alinan_toplam
            TextBox30 = odenen_toplam
            TextBox31 = kalan_toplam
        End If
    End With
    TextBox29 = Format(alinan_toplam, "#,##0.00  TL") 'SÜZÜLEN FORMATI
TextBox30 = Format(odenen_toplam, "#,##0.00  TL") 'SÜZÜLEN FORMATI
TextBox31 = Format(kalan_toplam, "#,##0.00  TL") 'SÜZÜLEN FORMATI
    
    ListBox1.ListIndex = 0
    
    
End Sub

 

[assenucler]

Sayın halit3,

Günaydınlar.

Çok güzel bir dosya, arşivime ekliyorum. Size, emek ve katkı verenlere teşekkürler.

Sevgi ve saygılar.

 

[ZorBey_]

Merhaba
Sayın
Halit3
Çok Teşekkür Ederim
Tam İstediğim Gibi
Allah Razı Olsun İyi Çalışmalar.