Listboxta Süzülen Veriyi Buton ekleyerek Farklı Kaydetmek

[1mak1mak]

Merhaba
Listboxta Süzülen Veriyi Buton ekleyerek Farklı Kaydetmek istiyorum ancak başaramadım ekte dosyamı paylaşıyorum.
Ustaların yardımlarını bekliyorum. Yardımcı olacaklara şimdiden çok teşekkürler.

 

[Korhan Ayhan]

Örnek;

Dosyanızın bulunduğu klasöre "Rapor.xlsx" adında bir dosya oluşturur.

Option Explicit

Private Sub CommandButton1_Click()
    Dim K1 As Workbook, S1 As Worksheet
  
    Set K1 = Workbooks.Add(1)
    Set S1 = K1.Sheets(1)
  
    S1.Range("A1").Resize(ListBox1.ListCount, ListBox1.ColumnCount) = ListBox1.List
    S1.Columns.AutoFit
    K1.SaveAs ThisWorkbook.Path & "\Rapor.xlsx"
    K1.Close
    Unload Me
  
    Set S1 = Nothing
    Set K1 = Nothing
End Sub

 

[1mak1mak]

Örnek;

Dosyanızın bulunduğu klasöre "Rapor.xlsx" adında bir dosya oluşturur.

Option Explicit

Private Sub CommandButton1_Click()
    Dim K1 As Workbook, S1 As Worksheet
   
    Set K1 = Workbooks.Add(1)
    Set S1 = K1.Sheets(1)
   
    S1.Range("A1").Resize(ListBox1.ListCount, ListBox1.ColumnCount) = ListBox1.List
    K1.SaveAs ThisWorkbook.Path & "\Rapor.xlsx"
    K1.Close
    Unload Me
   
    Set S1 = Nothing
    Set K1 = Nothing
End Sub

Çok Teşekkür ederim Korhan hocam ellerinize sağlık çok iyi çalışıyor.
Rapor dosyasında kaydederken Sütun genişliği ayarlanabilirmi ayarlanmıyorsa da önemli değil.

 

[1mak1mak]

Birde Enteresan bir durum oluştu Rapor Sayfasına iki farklı formatta sıralamada karışık tarih yazıp kaydediyor.
(gg/aa/yyyy) diğeri (aa.gg.yyyy)
Halbuki Listbox da tarihler normal gözüküyor.
Şimdi tekrar inceledim Listbox'ın verileri aldığı ana listede hücre formatları farklı bu yüzdenmiş.

 

[Korhan Ayhan]

Sütun genişlikleri için üstte ki koda küçük bir ekleme yaptım. Denersiniz.

 

[1mak1mak]

Sütun genişlikleri için üstte ki koda küçük bir ekleme yaptım. Denersiniz.

Teşekkür ederim halloldu elinize aklınıza sağlık.

 

[1mak1mak]

Sütun genişlikleri için üstte ki koda küçük bir ekleme yaptım. Denersiniz.

Hocam tekrar ben kızmayın ama şöyle bir durum oluştu Oluşturduğum Rapor.xls dosyasında
Tutar bölümünde Toplam almak istediğimde alamıyorum (. - ,) farklılıkları sorun çıkartıyor.
Tarihde gene (gg/aa/yyyy) - (aa.gg.yyyy) problemi var.
Daha önce gene sizin yardımcı olduğunuz bir kodda buna benzer problem vardı aşağıdaki kodla çözüm bulmuştunuz.
Bende o kodu kendime uyarlamak istedim ama hata veriyor. Eğer bu şekilde halledilebilirse nasıl bir değişiklik yapmam gerekir acaba.
Burada ben ( Function K_RTOPLA) yerine KRİTER kullandım. Ama çalışmadı acaba (Private Sub CommandButton2_Click()) iki kere
kullandığım için mi yoksa Kodu düzgün yapamadığım için mi yardımcı olabilirseniz çok sevinirim.
Bu Kodu Tarih hesabına dahil etmek için vermiştiniz. Örnek olarak yazdım buna benzer olurmu diye.

Private Sub CommandButton2_Click()
Function KRİTER(Kriter_Alanı_1 As Range, Kriter_Alanı_2 As Range)

Dim Veri As Range
End Sub

Private Sub CommandButton2_Click()
Dim K1 As Workbook, S1 As Worksheet
 
    Set K1 = Workbooks.Add(1)
    Set S1 = K1.Sheets(1)
   
    S1.Range("A1").Resize(ListBox1.ListCount, ListBox1.ColumnCount) = ListBox1.List
    If Evaluate(CLng(CDate(Replace(Kriter_Alanı_1.Cells(say, 1), "/", "."))) & Kriter_1) Then
    If Evaluate(CLng(CDate(Replace(Kriter_Alanı_2.Cells(say, 1), "/", "."))) & Kriter_2) Then
    S1.Columns.AutoFit
    K1.SaveAs ThisWorkbook.Path & "\Rapor.xlsx"
    K1.Close
    Unload Me
   
    Set S1 = Nothing
    Set K1 = Nothing
End Sub

 

[1mak1mak]

Benim için Rapor aldıktan sonra Tarihin görünümünden ziyade Tutar Sütununda Toplam almam çok önemli ama Tutar -0- çıkıyor.
Tek tek Nokta Virgül değiştirmek çok zor. Tarih kısmı keyfe keder çok önemli değil.

 

[Korhan Ayhan]

Bir örnek dosya eklerseniz bende test edebilirim.

 

[1mak1mak]

Bir örnek dosya eklerseniz bende test edebilirim.

Buyrun Hocam Hem çalışma dosyası hemde "mehmet" olarak filtre edilmiş Rapor dosyasını paylaştım.

 

[Korhan Ayhan]

Deneyiniz.

 

[1mak1mak]

Deneyiniz.

Hocam Teşekkürler
Tarihler düzelmiş ama Rapor'da D Sütunundaki Tutarların Toplamını gene alamıyorum.
Kodda düzenleme yapmışsınız ama gene -0- veriyor Nokta Virgül kaynaklı.
Aramayı "fast" diye yaparak denerseniz binli rakkamlarda süzülecek görmek daha belli oluyor.

 

[Korhan Ayhan]

Ben binli tutarlarda denediğimde sorun yaşamadım.

Siz kodu birde aşağıdaki gibi deneyin.

Private Sub CommandButton2_Click()
    Dim K1 As Workbook, S1 As Worksheet
   
    Set K1 = Workbooks.Add(1)
    Set S1 = K1.Sheets(1)
    
    S1.Range("A1").Resize(ListBox1.ListCount, ListBox1.ColumnCount) = ListBox1.List
    S1.Columns.AutoFit
    S1.Range("D:D").Replace " TL", ""
    S1.Range("D:D").Replace ".", ""
    S1.Range("A:A").TextToColumns Destination:=S1.Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 4), TrailingMinusNumbers:=True
    S1.Range("D:D").TextToColumns Destination:=S1.Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    S1.Cells(S1.Rows.Count, 4).End(3)(2, 1).Formula = "=SUM(D1:D" & S1.Cells(S1.Rows.Count, 4).End(3).Row & ")"
    S1.Range("D:D").NumberFormat = "#,##0.00 TL"
    
    K1.SaveAs ThisWorkbook.Path & "\Rapor.xlsx"
    K1.Close
    Unload Me
    
    Set S1 = Nothing
    Set K1 = Nothing
End Sub

 

[1mak1mak]

Ben binli tutarlarda denediğimde sorun yaşamadım.

Siz kodu birde aşağıdaki gibi deneyin.

Private Sub CommandButton2_Click()
    Dim K1 As Workbook, S1 As Worksheet
 
    Set K1 = Workbooks.Add(1)
    Set S1 = K1.Sheets(1)
  
    S1.Range("A1").Resize(ListBox1.ListCount, ListBox1.ColumnCount) = ListBox1.List
    S1.Columns.AutoFit
    S1.Range("D:D").Replace " TL", ""
    S1.Range("D:D").Replace ".", ""
    S1.Range("A:A").TextToColumns Destination:=S1.Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 4), TrailingMinusNumbers:=True
    S1.Range("D:D").TextToColumns Destination:=S1.Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    S1.Cells(S1.Rows.Count, 4).End(3)(2, 1).Formula = "=SUM(D1:D" & S1.Cells(S1.Rows.Count, 4).End(3).Row & ")"
    S1.Range("D:D").NumberFormat = "#,##0.00 TL"
  
    K1.SaveAs ThisWorkbook.Path & "\Rapor.xlsx"
    K1.Close
    Unload Me
  
    Set S1 = Nothing
    Set K1 = Nothing
End Sub

Yok olmadı hocam bin ayracını kaldırmışsınız ama bende Raporda kuruş hanesine
nokta koyması gerekirken gene virgül koyuyor sanıyorum bu sebepten olmuyor.
Elle nokta olarak düzelttiğimde düzeliyor.

 

[Korhan Ayhan]

O zaman sizin binlik ve ondalık ayıraçlarınız farklı gibi görünüyor.

Birde ekteki dosyayı deneyiniz.

 

[1mak1mak]

O zaman sizin binlik ve ondalık ayıraçlarınız farklı gibi görünüyor.

Birde ekteki dosyayı deneyiniz.

Hocam sizide gece vakti yordum.
Denedim ama netice çok parlak olmadı. Esasında bir çok listede farklı Makro kullanıyorum böyle bir şeyle ilk karşılaşıyorum.
Sizde normal olup bende nasıl böyle oluyor anlamadım bende her şey Ana veri listesinde de normal Rapor alınca bozuluyor.
Son örnek daha ilginç paylaşıyorum. ListBox da nokta virgülün yeri değişince ListBox Pencere içeriğide bozuldu.
Acaba CommandButton2 bölümünde ikili bir Replace yapılsa nasıl olur.
Burada S1.Range("D").NumberFormat = "#,##0.00 TL" kullanarak

    S1.Range("D:D").Replace ".", ""

 

[1mak1mak]

Hocam fırsatınız olurda bakarsanız bir şekilde Buradaki Linkte de bu konuya değinilip çözüm üretilmiş.
Ben pek anlayamadım.

 

[Korhan Ayhan]

Siz exceldeki ondalık ve binlik ayıracınız ile denetim masasındaki ondalık ve binlik ayıraçlarınızın aynı olup olmadığını kontrol ediniz.

Ben ekteki sonuçları alıyorum.

 

[1mak1mak]

Hocam baktım fark yok neyse yordum sizi bende bir şekilde bir problem var herhalde.
Esasında şöyle çözdüm sizin bin ayracını kaldırdığınız Kodu kullanıp Rapor aldıktan sonra Rapor dosyasında
Tutar Sütununu seçip binlik ayraç olmadığı için Değiştiri seçip virgülü nokta ile tümünü değiştir dediğimde
problem kalmıyor hatta binlik ayracı ve rakkamın sonuna TL yi otamatik olarak ekliyor.
Bu şekilde daha kolay halloluyor.
Tüm yardımlarınız için çok teşekkür ederim.

Değiştirilmemiş ve Değiştirilmiş Rapor Dosyaları ekte Sadece Virgül ile Noktayı Tümünü Değiştir yaptım.

 

[1mak1mak]

Siz exceldeki ondalık ve binlik ayıracınız ile denetim masasındaki ondalık ve binlik ayıraçlarınızın aynı olup olmadığını kontrol ediniz.
Ben ekteki sonuçları alıyorum.

Hocam Tekrar merhaba Rapor Kaydederken sonuna Tarih ekledim çünkü sürekli aynı isimi vermesi sıkıntı yaratıyordu.
Tarihte de aynı gün başka Rapor aldığımda gene aynı isim oluyor. Aklıma Saat de ekleyeyimde farklılık olsun dedim ama saat ekleyemedim
hata alıyorum. Esasında Dosya ismi varsa sonuna sayı attırabilirsek oda işimi görür.
Hangisi sizin için daha kolay olabilirse olur.
Yardımcı olurmusunuz kodu nasıl düzenleyeyim. Şimdiden Teşekkürler.

K1.SaveAs ThisWorkbook.Path & "\Rapor_" & Date & ".xlsx"