• DİKKAT

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

ListWiev deki İki tarih arasındaki verileri DTPicker ve Combobox ile süzüp aktarma

  • Konbuyu başlatan Konbuyu başlatan gezgin64
  • Başlangıç tarihi Başlangıç tarihi
G

gezgin64

Misafir
ListWiev deki İki tarih arasındaki verileri DTPicker ve Combobox ile süzüp Sayfa 3 e hızlı bir şekilde aktarmak istiyorum. Ama ListWiev deki birinci sutunu aktarmayı başaramadım. Yardımcı olursanız sevinirim.
 

Ekli dosyalar

bunu denermisiniz.


Private Sub CommandButton4_Click()
yer = "Sayfa3"
If yer = "" Then
MsgBox "aktarılacak sayfa seçimini yapmadınız"
Exit Sub
End If
Sheets(yer).Cells(1, 1).Value = ListView1.ColumnHeaders(1).Text
Sheets(yer).Cells(1, 1).Font.Bold = True
For n = 1 To Val(ListView1.ColumnHeaders.Count) - 1
Sheets(yer).Cells(1, n + 1).Value = ListView1.ColumnHeaders(n + 1).Text
Sheets(yer).Cells(1, n + 1).Font.Bold = True
Next
sat1 = Worksheets(yer).[a65536].End(3).Row + 1
For r = 1 To ListView1.ListItems.Count + 1
Sheets(yer).Cells(sat1, 1).Value = ListView1.ListItems(r).Text
On Error Resume Next
For i = 0 To ListView1.ColumnHeaders.Count - 1
Sheets(yer).Cells(sat1, i + 1).Value = ListView1.ListItems(r).ListSubItems(i).Text
Next i
sat1 = sat1 + 1
Next r
MsgBox "işlem tamam"
End Sub
Genişletmek için tıkla ...
 
öncelikle yardımcı olmaya çalıştığınız için teşekkür ederim.

Ancak;

1-başlıktaki A1 hücresindeki "SIRA" veriyi aktarmıyor
2-kullanacağım gerçek veriler üzerinde denediğimde hücre/yazı "tarih" formatında olmasına rağmen doğru sonuçları vermiyor
2-Çok yavaş çalışıyor, iki satırın aktarma işlemi 30 sn sürdü, benim kullanacağım kayıt miktarında bu aktarılacak satır sayısı 500, 600 olacak, buna benzer aktarma işlemi yapan ComcoBox lı örneklerde bu işlem 2-3 sn sürüyor. aktarma işlemini hızlandırabilir miyiz.

şimdiden teşekkürler
 
Son düzenleme:
2 nolu mesajdaki kodu yeniden düzenledim
 
gezgin64' Alıntı:
ListWiev deki İki tarih arasındaki verileri DTPicker ve Combobox ile süzüp Sayfa 3 e hızlı bir şekilde aktarmak istiyorum. Ama ListWiev deki birinci sutunu aktarmayı başaramadım. Yardımcı olursanız sevinirim.
Genişletmek için tıkla ...


Ekli dosyayı inceleyin.İstediğiniz olmuşmu?:cool:
 

Ekli dosyalar

Yardımlarınıza teşekkür ediyorum.
Yalnız; Evren beyin eklediği dosya için;

-Başlıktan A1 hücresini haricindekileri aktarmıyordu. Aşağıdaki koddaki yaptığım değişiklikle sorunum halledilmiş oldu. Diğer ziyaretçilerin de faydalanması için CommandButton4 ait kod içindeki;

Kod: 
Sheets(yer).Cells(1, 1).Value = Sheets(yer1).Cells(1, 1).Value

kodunu aşağıdaki kodla değiştirilmesi gerekiyor;

Kod: 
For n = 0 To Val(ListView1.ColumnHeaders.Count) - 1
Sheets("Sayfa3").Cells(1, n + 1).Value = ListView1.ColumnHeaders(n + 1).Text
Sheets("Sayfa3").Cells(1, n + 1).Font.Bold = True
Next

Teşekkürler
 
Son düzenleme:
gezgin64' Alıntı:
Yardımlarınıza teşekkür ediyorum.
Yalnız; Evren beyin eklediği dosya için;

-Başlıktan A1 hücresini haricindekileri aktarmıyordu. Aşağıdaki koddaki yaptığım değişiklikle sorunum halledilmiş oldu. Diğer ziyaretçilerin de faydalanması için CommandButton4 ait kod içindeki;

Kod: 
Sheets(yer).Cells(1, 1).Value = Sheets(yer1).Cells(1, 1).Value

kodunu aşağıdaki kodla değiştirilmesi gerekiyor;

Kod: 
For n = 0 To Val(ListView1.ColumnHeaders.Count) - 1
Sheets("Sayfa3").Cells(1, n + 1).Value = ListView1.ColumnHeaders(n + 1).Text
Sheets("Sayfa3").Cells(1, n + 1).Font.Bold = True
Next

Teşekkürler
Genişletmek için tıkla ...
Başlığı her defasında aktarmaya gerek yok ki zaten
O satrır sanırım ben sildim.Manuel elle bir kere girin bu yetrlidir.Her defasında exel vba yazıyor diye yazdırmanın bir manası yok onu.Başlık zaten sabit.:cool:
 
Yukarıdaki değişikliğin yapılması hem kodların tamamlanması (DTPicker ile yapılmış benzer örneğe rastlamadığım için) hem de aynı sayfanın başka amaçla da kullanılabilmesi açısından faydalı olacağını düşündüm.

Sayfanın temizlenip yeniden veri yüklendiğinde başlık kısmı boş kalmaması açısından bana gerekli idi. Ben 8-10 farklı işlem yapıp, aynı sayfadan başlıkları farklı olan verileri yazıcıdan çıktı almak istiyorum. Sayfa sayısının artmasını istemeyenlere gerekebilir diye belirtmek istedim.

Yardımlarınıza teşekkürler.
 
evren hocam, halit hocam güzel çalışma olmuş elinize sağlık, bu tabloda 5. satırdan sonrasını aktarması için nereyi değiştirebiliriz. ben yapıyorum bişiler hata verip duruyo :)
 
barabba' Alıntı:
evren hocam, halit hocam güzel çalışma olmuş elinize sağlık, bu tabloda 5. satırdan sonrasını aktarması için nereyi değiştirebiliriz. ben yapıyorum bişiler hata verip duruyo :)
Genişletmek için tıkla ...
5nicstrıdandan sonrasını zatemn aktarıyor.
Bizim yolladığımız dosyaya bakın.Neler yapabiliyor.Sonra kendi dosyanıza bakın .Eğer bizim yolladığımız dosya bir işlkemi yapıyorda sizin üzerinde çalıştığınız dosay yapamıyorsa hata sizdedir.
Mesela 5nci satırdan sonrasını atmıyor diyorsunuz.Bizim yolladığımız dosyaya baktınızmı.Atıyromu?Eğer atıyorsa atmıyor dememelisiniz.Benim yapmaya çalıştığım dosyada atmıyor demelisiniz.Bu durumda insanlar bizim hatalı dosya yaptığımızı sanacaklar.:cool:
 
Yukarıdaki örnekte Userform 20.000 ve üzeri kayıt olduğunda geç açılıyor. Bu nedenle yaptığım araştırmada aşağıdaki kodların % 50 daha hızlı çalıştığını gördüm.
Kod: 
Private Sub UserForm_Initialize()

Dim sh As Worksheet, rng As Range, Baslik As Range
Dim i%, J%, Y%
Dim bas As Variant
Set sh = Sheets("Sayfa1") 
Set rng = sh.[A1].CurrentRegion
Set Baslik = sh.Range(sh.Cells(1, 1), sh.Cells(1, sh.Cells(1, 255).End(1).Column))
ReDim arrVeri(1 To rng.Rows.Count, 1 To rng.Columns.Count)
For i = 1 To rng.Rows.Count
    For J = 1 To rng.Columns.Count
        arrVeri(i, J) = sh.Cells(i + 1, J)
    Next J
Next i

With ListView1
   .ListItems.Clear
   .ColumnHeaders.Clear
   .View = lvwReport
   .Gridlines = True
   .FullRowSelect = True
    For Each bas In Baslik
        .ColumnHeaders.Add , , bas.Text
    Next
On Error Resume Next
    For i = 1 To rng.Rows.Count
        Y = Y + 1
        .ListItems.Add , , arrVeri(i, 1)
        For J = 1 To rng.Columns.Count
            .ListItems(Y).SubItems(J) = arrVeri(i, J + 1)
        Next J
    Next i
End With
Set sh = Nothing
Set rng = Nothing
Set Baslik = Nothing

End Sub
Ancak bu kodlarda sütun genişliklerini nasıl ayarlayabileceğimi bulamadım. ListWiev in daha hızlı çalışması konusunda yeni bir koda veya en azından yukardaki kodlarda sutun genişliklerini ayarlayabilmem konusunda yardım edebilirseniz sevinirim.
 
gezgin64' Alıntı:
Yukarıdaki örnekte Userform 20.000 ve üzeri kayıt olduğunda geç açılıyor. Bu nedenle yaptığım araştırmada aşağıdaki kodların % 50 daha hızlı çalıştığını gördüm.
Kod: 
Private Sub UserForm_Initialize()
 
Ancak bu kodlarda sütun genişliklerini nasıl ayarlayabileceğimi bulamadım. ListWiev in daha hızlı çalışması konusunda yeni bir koda veya en azından yukardaki kodlarda sutun genişliklerini ayarlayabilmem konusunda yardım edebilirseniz sevinirim.[/quote]
 
bunu denermisiniz.
 
[CODE]Private Sub UserForm_Initialize()
Dim sh As Worksheet, rng As Range, Baslik As Range
Dim i%, J%, Y%
Dim bas As Variant
Set sh = Sheets("Sayfa1")
Set rng = sh.[A1].CurrentRegion
Set Baslik = sh.Range(sh.Cells(1, 1), sh.Cells(1, sh.Cells(1, 255).End(1).Column))
ReDim arrVeri(1 To rng.Rows.Count, 1 To rng.Columns.Count)
For i = 1 To rng.Rows.Count
For J = 1 To rng.Columns.Count
arrVeri(i, J) = sh.Cells(i + 1, J)
        
Next J
Next i
With ListView1
.ListItems.Clear
.ColumnHeaders.Clear
.View = lvwReport
.Gridlines = True
.FullRowSelect = True
For Each bas In Baslik
[COLOR=darkred][COLOR=red]x = x + 1[/COLOR]
[/COLOR].ColumnHeaders.Add , , [COLOR=red]sh.Cells(1, x)
[/COLOR][COLOR=red]ListView1.ColumnHeaders(x).Width = sh.Columns(x).Width[/COLOR]
Next
On Error Resume Next
For i = 1 To rng.Rows.Count
Y = Y + 1
.ListItems.Add , , arrVeri(i, 1)
For J = 1 To rng.Columns.Count
.ListItems(Y).SubItems(J) = arrVeri(i, J + 1)
Next J
Next i
End With
Set sh = Nothing
Set rng = Nothing
Set Baslik = Nothing
End Sub
Genişletmek için tıkla ...
 
barabba' Alıntı:
evren hocam, halit hocam güzel çalışma olmuş elinize sağlık, bu tabloda 5. satırdan sonrasını aktarması için nereyi değiştirebiliriz. ben yapıyorum bişiler hata verip duruyo :)
Genişletmek için tıkla ...

herhalde verileri 5 satırdan sonrasını aldırmak istiyorsunuz.

bunu
Kod: 
 For i = 2 To EndRow
bununla değiştiriniz.
Kod: 
[COLOR=red] For i = 5 To EndRow[/COLOR]

burayıda

Kod: 
With ListView1
        For i = 2 To s1.[a65536].End(3).Row
            .ListItems.Add , , s1.Cells(i, "A")
            .ListItems(i - 1).SubItems(1) = s1.Cells(i, "B")
            .ListItems(i - 1).SubItems(2) = s1.Cells(i, "C")
            .ListItems(i - 1).SubItems(3) = s1.Cells(i, "D")
            .ListItems(i - 1).SubItems(4) = s1.Cells(i, "E")
            .ListItems(i - 1).SubItems(5) = s1.Cells(i, "F")
            .ListItems(i - 1).SubItems(6) = s1.Cells(i, "G")
            .ListItems(i - 1).SubItems(7) = s1.Cells(i, "H")
            .ListItems(i - 1).SubItems(8) = s1.Cells(i, "I")
            .ListItems(i - 1).SubItems(9) = s1.Cells(i, "J")
            .ListItems(i - 1).SubItems(10) = s1.Cells(i, "K")
            .ListItems(i - 1).SubItems(11) = s1.Cells(i, "L")

bununla değiştiriniz.

Kod: 
With ListView1
        For i = 2 To s1.[a65536].End(3).Row
            .ListItems.Add , , s1.Cells(i + 3, "A")
            [COLOR=red].ListItems(i - 1).SubItems(1) = s1.Cells(i + 3, "B")
            .ListItems(i - 1).SubItems(2) = s1.Cells(i + 3, "C")
            .ListItems(i - 1).SubItems(3) = s1.Cells(i + 3, "D")
            .ListItems(i - 1).SubItems(4) = s1.Cells(i + 3, "E")
            .ListItems(i - 1).SubItems(5) = s1.Cells(i + 3, "F")
            .ListItems(i - 1).SubItems(6) = s1.Cells(i + 3, "G")
            .ListItems(i - 1).SubItems(7) = s1.Cells(i + 3, "H")
            .ListItems(i - 1).SubItems(8) = s1.Cells(i + 3, "I")
            .ListItems(i - 1).SubItems(9) = s1.Cells(i + 3, "J")
            .ListItems(i - 1).SubItems(10) = s1.Cells(i + 3, "K")
            .ListItems(i - 1).SubItems(11) = s1.Cells(i + 3, "L")[/COLOR]
 
Evren Gizlen' Alıntı:
5nicstrıdandan sonrasını zatemn aktarıyor.
Bizim yolladığımız dosyaya bakın.Neler yapabiliyor.Sonra kendi dosyanıza bakın .Eğer bizim yolladığımız dosya bir işlkemi yapıyorda sizin üzerinde çalıştığınız dosay yapamıyorsa hata sizdedir.
Mesela 5nci satırdan sonrasını atmıyor diyorsunuz.Bizim yolladığımız dosyaya baktınızmı.Atıyromu?Eğer atıyorsa atmıyor dememelisiniz.Benim yapmaya çalıştığım dosyada atmıyor demelisiniz.Bu durumda insanlar bizim hatalı dosya yaptığımızı sanacaklar.:cool:
Genişletmek için tıkla ...

hocam yanlış anlamışsınız yada ben eksik soru sordum kusura bakmayın, aktarmıyor demedim çok güzel çalışıyor zaten, benim yapmak istediğim 5. satırdan sonrasını aktarsın ilk 4 satıra ben başka formül, toplam aldırma, süzme gibi şeyler ekleyeceğimden ilk 4 satırın sabit kalmasını istemiştim:) yapmaya çalıştım beceremedimde :(
 
barabba' Alıntı:
hocam yanlış anlamışsınız yada ben eksik soru sordum kusura bakmayın, aktarmıyor demedim çok güzel çalışıyor zaten, benim yapmak istediğim 5. satırdan sonrasını aktarsın ilk 4 satıra ben başka formül, toplam aldırma, süzme gibi şeyler ekleyeceğimden ilk 4 satırın sabit kalmasını istemiştim:) yapmaya çalıştım beceremedimde :(
Genişletmek için tıkla ...
Halit beyin verdiği 13 ncü mesajdaki kodları denedinizmi?
 
halit3' Alıntı:
herhalde verileri 5 satırdan sonrasını aldırmak istiyorsunuz.

bunu
Kod: 
 For i = 2 To EndRow
bununla değiştiriniz.
Kod: 
[COLOR=red] For i = 5 To EndRow[/COLOR]

burayıda

Kod: 
With ListView1
        For i = 2 To s1.[a65536].End(3).Row
            .ListItems.Add , , s1.Cells(i, "A")
            .ListItems(i - 1).SubItems(1) = s1.Cells(i, "B")
            .ListItems(i - 1).SubItems(2) = s1.Cells(i, "C")
            .ListItems(i - 1).SubItems(3) = s1.Cells(i, "D")
            .ListItems(i - 1).SubItems(4) = s1.Cells(i, "E")
            .ListItems(i - 1).SubItems(5) = s1.Cells(i, "F")
            .ListItems(i - 1).SubItems(6) = s1.Cells(i, "G")
            .ListItems(i - 1).SubItems(7) = s1.Cells(i, "H")
            .ListItems(i - 1).SubItems(8) = s1.Cells(i, "I")
            .ListItems(i - 1).SubItems(9) = s1.Cells(i, "J")
            .ListItems(i - 1).SubItems(10) = s1.Cells(i, "K")
            .ListItems(i - 1).SubItems(11) = s1.Cells(i, "L")

bununla değiştiriniz.

Kod: 
With ListView1
        For i = 2 To s1.[a65536].End(3).Row
            .ListItems.Add , , s1.Cells(i + 3, "A")
            [COLOR=red].ListItems(i - 1).SubItems(1) = s1.Cells(i + 3, "B")
            .ListItems(i - 1).SubItems(2) = s1.Cells(i + 3, "C")
            .ListItems(i - 1).SubItems(3) = s1.Cells(i + 3, "D")
            .ListItems(i - 1).SubItems(4) = s1.Cells(i + 3, "E")
            .ListItems(i - 1).SubItems(5) = s1.Cells(i + 3, "F")
            .ListItems(i - 1).SubItems(6) = s1.Cells(i + 3, "G")
            .ListItems(i - 1).SubItems(7) = s1.Cells(i + 3, "H")
            .ListItems(i - 1).SubItems(8) = s1.Cells(i + 3, "I")
            .ListItems(i - 1).SubItems(9) = s1.Cells(i + 3, "J")
            .ListItems(i - 1).SubItems(10) = s1.Cells(i + 3, "K")
            .ListItems(i - 1).SubItems(11) = s1.Cells(i + 3, "L")[/COLOR]
Genişletmek için tıkla ...

halit hocam, evren hocam teşekkür ederim, aradığım buydu...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst