• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

  • Konbuyu başlatan Konbuyu başlatan 1mak1mak
  • Başlangıç tarihi Başlangıç tarihi
1

1mak1mak

Katılım
9 Ocak 2011
Mesajlar
354
Excel Vers. ve Dili
2007 Türkçe
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.
 

Ekli dosyalar

Örnek;

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

C++: 
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
 
Korhan Ayhan' Alıntı:
Örnek;

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

C++: 
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
Genişletmek için tıkla ...
Ç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.
 
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ş.
 
Son düzenleme:
Sütun genişlikleri için üstte ki koda küçük bir ekleme yaptım. Denersiniz.
 
Korhan Ayhan' Alıntı:
Sütun genişlikleri için üstte ki koda küçük bir ekleme yaptım. Denersiniz.
Genişletmek için tıkla ...
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.
Kod: 
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
 
Son düzenleme:
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.
 
Bir örnek dosya eklerseniz bende test edebilirim.
 
Korhan Ayhan' Alıntı:
Deneyiniz.
Genişletmek için tıkla ...
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.
 

Ekli dosyalar

Son düzenleme:
Ben binli tutarlarda denediğimde sorun yaşamadım.

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

C++: 
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
 
Korhan Ayhan' Alıntı:
Ben binli tutarlarda denediğimde sorun yaşamadım.

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

C++: 
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
Genişletmek için tıkla ...
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.
 
O zaman sizin binlik ve ondalık ayıraçlarınız farklı gibi görünüyor.

Birde ekteki dosyayı deneyiniz.
 

Ekli dosyalar

Korhan Ayhan' Alıntı:
O zaman sizin binlik ve ondalık ayıraçlarınız farklı gibi görünüyor.

Birde ekteki dosyayı deneyiniz.
Genişletmek için tıkla ...
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:D").NumberFormat = "#,##0.00 TL" kullanarak

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

Ekli dosyalar

Son düzenleme:
Hocam fırsatınız olurda bakarsanız bir şekilde Buradaki Linkte de bu konuya değinilip çözüm üretilmiş.
Ben pek anlayamadım.
 
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.
 

Ekli dosyalar

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.
 

Ekli dosyalar

Korhan Ayhan' Alıntı:
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.
Genişletmek için tıkla ...

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.

Kod: 
K1.SaveAs ThisWorkbook.Path & "\Rapor_" & Date & ".xlsx"
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst