Herkese merhaba
UserForm'daki Combobox'la listview'deki datalari asagidaki Kod 2 ile suzuyorum, datalar excel "Rapor" sayfasindan geliyor, (suzmeler Combobox'taki sahis isimleri olarak yapilir)
Yeni bir sayfa actim ve o sayfaya "Rapor" sayfasindan Advance Filter ile suzme yaptim ve sayfanin adini "Filter"koydum,
UserForm combobox'ta secilen, filter sayfasinda L2 hucresine ismi giriyor ve Kod1 ile o isme ait datalar suzuluyor , grafik olusturuluyor (Koddaki Criteria L2 hucresidir) bu grafik UserForm'a ekleniyor.
Hersey guzel calisiyor, her sectigim isime ait datalar suzuluyor ,grafik olusturuluyor ve image olarak Kod 3 ile UserForma aktariliyor.
Tek problem Kod3'u, Kod2'nin icine ekledigimde suzme dongu'ye giriyor ve eger bir isme bagli cok data var ise "Rapor" ve "Filter" sayfalari arasinda belli bir sure dongu olusuyor ve suzmenin tamamlamasi bayagi zaman aliyor. Ager data az ise bu bir kac saniye suruyor ama 20 sira uzeri data var ise bu 25-30 saniye suruyor, sadece Kod 2 ile suzme yaparsam suzme aninda oluyor ama tabi amacim grafik eklemek oldu gu icin Kod3'u, Kod2'nin icinde kullanmam lazim.
Baglantili oldugu icin Kod 4 de ekledim.
Grafik eklememeyi hizli suzmeyle nasil yapabilirim, butun mesele bu? yardimci olursaniz cok sevinirim
Kod 1:
Sub Filter2()
Sheets("Filter").Select
Range("'Sample Unpaid invoices live4.xls'!Rapor").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Range("Filter!Criteria"), CopyToRange:=Range( _
"A6:Y6"), Unique:=False
Sheets("Rapor").Select
End Sub
Kod 2:
Private Sub ComboBox2_Change()
'Application.ScreenUpdating = False
Dim x As Integer
Dim Liste As ListItem ' Öncelikle list item için bir deðiþken tanýmlayalým
ListView1.ListItems.Clear 'Daha önceden ListView nesnemizde veri olabileceði için bu nesnenin için temizleyelim.
For i = 2 To [a65536].End(3).Row 'Þimdi verileri almak için bir Döngü kuralým . Bu döngü bizim için 2 den baþlayarak son dolu olan satýr kaçýncý satýrsa o kadar saysýn.
If Cells(i, 7).Value = Me.ComboBox2.Value Then
x = x + 1 'Satýrlarýmýzý numaralandýrmak için deðer atayalým. Döngümüz her döndüðünde deðer 1 artacaktýr. Burda neden i kullanmayýp ta farklý bir deðer kullandýðýmýzý daha sonraki derslerimizde çok iyi anlayacaksýnýz ..
Set Liste = ListView1.ListItems.Add(, , Cells(i, 1).Value) ' Artýk verilerimizi almaya baþladýk. Birinci sütuna birinci satýrdaki veriler sýrasýyla alýnmaya baþlýyor.
Liste.SubItems(1) = Cells(i, 2).Value 'Ýkinci sütuna 2. sütun. Burda baþta 1 yazýyor çünkü ListViewýn ilk kolunu 1 deðil 0. Burayý karýþtýrmamak gerekiyor.
Liste.SubItems(2) = Cells(i, 3).Value 'Üçüncü sütuna 3. sütun
Liste.SubItems(3) = Cells(i, 4).Value
Liste.SubItems(4) = Cells(i, 5).Value
Liste.SubItems(5) = Cells(i, 6).Value
Liste.SubItems(6) = Cells(i, 7).Value
Liste.SubItems(7) = Cells(i, 8).Value
Liste.SubItems(8) = Format(Cells(i, 9).Value, "£#,##0.00")
Liste.SubItems(9) = Format(Cells(i, 10).Value, "£#,##0.00")
Liste.SubItems(10) = Format(Cells(i, 11).Value, "£#,##0.00")
Liste.SubItems(11) = Format(Cells(i, 12).Value, "£#,##0.00")
Liste.SubItems(12) = Format(Cells(i, 13).Value, "£#,##0.00")
Liste.SubItems(13) = Format(Cells(i, 14).Value, "£#,##0.00")
Liste.SubItems(14) = Format(Cells(i, 15).Value, "£#,##0.00")
Liste.SubItems(15) = Format(Cells(i, 16).Value, "£#,##0.00")
Liste.SubItems(16) = Format(Cells(i, 17).Value, "£#,##0.00")
Liste.SubItems(18) = Format(Cells(i, 20).Value, "£#,##0.00")
Liste.SubItems(17) = Cells(i, 18).Value 'Notes
Liste.SubItems(18) = Cells(i, 19).Value 'Notes
Liste.SubItems(19) = Format(Cells(i, 20).Value, "£#,##0.00")
Liste.SubItems(20) = Cells(i, 21).Value
Liste.SubItems(21) = Cells(i, 22).Value
Liste.SubItems(22) = Cells(i, 23).Value
Liste.SubItems(23) = Cells(i, 24).Value
Liste.SubItems(24) = Cells(i, 25).Value
TextBox22.Value = ""
On Error Resume Next
End If
Next i
On Error GoTo 0
Set Liste = Nothing
TextBox27 = ComboBox2.Text
ListView1.FullRowSelect = True '(liste elemanini seçtiginizde tüm satir seçili olur. Sadece lvwReport..(Ayrintilar) görünümünde geçerlidir
ListView1.Gridlines = True '(listeyi çizgili yapar. Bu özellik sadece lvwReport...(Ayrintilar) görünümünde geçerlidir)
TextBox21 = WorksheetFunction.Sum([I:I]) ' textbox'a toplam alir
TextBox21.Value = Format(TextBox21, "£#,##0.00")
TextBox26.Value = ""
ComboBox1.Value = ""
'CommandButtonCB2_Click
Sheets("Rapor").Select
Range("E2", Range("E65536").End(xlUp)).Select
Selection.TextToColumns Destination:=Range("E2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Sheets("DATA").Select
Range("A2", Range("A65536").End(xlUp)).Select
Sheets("invoice").Select
Selection.TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("A2").Select
Sheets("Rapor").Select
Range("A2").Select
End Sub
Kod 3 :
Sheets("Filter").Range("L2").Value = ComboBox2.Value
Filter2
Call SaveChart
UserForm1.Image24.Picture = LoadPicture(Fname)
Fname = ThisWorkbook.Path & "\temp1.gif"
Kod 4:
Private Sub SaveChart()
Dim MyChart As Chart
Dim Fname As String
Set MyChart = Sheets("Filter").ChartObjects(1).Chart
Fname = ThisWorkbook.Path & "\temp1.gif"
MyChart.Export Filename:=Fname, FilterName:="GIF"
End Sub
saygilar sunuyorum
UserForm'daki Combobox'la listview'deki datalari asagidaki Kod 2 ile suzuyorum, datalar excel "Rapor" sayfasindan geliyor, (suzmeler Combobox'taki sahis isimleri olarak yapilir)
Yeni bir sayfa actim ve o sayfaya "Rapor" sayfasindan Advance Filter ile suzme yaptim ve sayfanin adini "Filter"koydum,
UserForm combobox'ta secilen, filter sayfasinda L2 hucresine ismi giriyor ve Kod1 ile o isme ait datalar suzuluyor , grafik olusturuluyor (Koddaki Criteria L2 hucresidir) bu grafik UserForm'a ekleniyor.
Hersey guzel calisiyor, her sectigim isime ait datalar suzuluyor ,grafik olusturuluyor ve image olarak Kod 3 ile UserForma aktariliyor.
Tek problem Kod3'u, Kod2'nin icine ekledigimde suzme dongu'ye giriyor ve eger bir isme bagli cok data var ise "Rapor" ve "Filter" sayfalari arasinda belli bir sure dongu olusuyor ve suzmenin tamamlamasi bayagi zaman aliyor. Ager data az ise bu bir kac saniye suruyor ama 20 sira uzeri data var ise bu 25-30 saniye suruyor, sadece Kod 2 ile suzme yaparsam suzme aninda oluyor ama tabi amacim grafik eklemek oldu gu icin Kod3'u, Kod2'nin icinde kullanmam lazim.
Baglantili oldugu icin Kod 4 de ekledim.
Grafik eklememeyi hizli suzmeyle nasil yapabilirim, butun mesele bu? yardimci olursaniz cok sevinirim
Kod 1:
Sub Filter2()
Sheets("Filter").Select
Range("'Sample Unpaid invoices live4.xls'!Rapor").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Range("Filter!Criteria"), CopyToRange:=Range( _
"A6:Y6"), Unique:=False
Sheets("Rapor").Select
End Sub
Kod 2:
Private Sub ComboBox2_Change()
'Application.ScreenUpdating = False
Dim x As Integer
Dim Liste As ListItem ' Öncelikle list item için bir deðiþken tanýmlayalým
ListView1.ListItems.Clear 'Daha önceden ListView nesnemizde veri olabileceði için bu nesnenin için temizleyelim.
For i = 2 To [a65536].End(3).Row 'Þimdi verileri almak için bir Döngü kuralým . Bu döngü bizim için 2 den baþlayarak son dolu olan satýr kaçýncý satýrsa o kadar saysýn.
If Cells(i, 7).Value = Me.ComboBox2.Value Then
x = x + 1 'Satýrlarýmýzý numaralandýrmak için deðer atayalým. Döngümüz her döndüðünde deðer 1 artacaktýr. Burda neden i kullanmayýp ta farklý bir deðer kullandýðýmýzý daha sonraki derslerimizde çok iyi anlayacaksýnýz ..
Set Liste = ListView1.ListItems.Add(, , Cells(i, 1).Value) ' Artýk verilerimizi almaya baþladýk. Birinci sütuna birinci satýrdaki veriler sýrasýyla alýnmaya baþlýyor.
Liste.SubItems(1) = Cells(i, 2).Value 'Ýkinci sütuna 2. sütun. Burda baþta 1 yazýyor çünkü ListViewýn ilk kolunu 1 deðil 0. Burayý karýþtýrmamak gerekiyor.
Liste.SubItems(2) = Cells(i, 3).Value 'Üçüncü sütuna 3. sütun
Liste.SubItems(3) = Cells(i, 4).Value
Liste.SubItems(4) = Cells(i, 5).Value
Liste.SubItems(5) = Cells(i, 6).Value
Liste.SubItems(6) = Cells(i, 7).Value
Liste.SubItems(7) = Cells(i, 8).Value
Liste.SubItems(8) = Format(Cells(i, 9).Value, "£#,##0.00")
Liste.SubItems(9) = Format(Cells(i, 10).Value, "£#,##0.00")
Liste.SubItems(10) = Format(Cells(i, 11).Value, "£#,##0.00")
Liste.SubItems(11) = Format(Cells(i, 12).Value, "£#,##0.00")
Liste.SubItems(12) = Format(Cells(i, 13).Value, "£#,##0.00")
Liste.SubItems(13) = Format(Cells(i, 14).Value, "£#,##0.00")
Liste.SubItems(14) = Format(Cells(i, 15).Value, "£#,##0.00")
Liste.SubItems(15) = Format(Cells(i, 16).Value, "£#,##0.00")
Liste.SubItems(16) = Format(Cells(i, 17).Value, "£#,##0.00")
Liste.SubItems(18) = Format(Cells(i, 20).Value, "£#,##0.00")
Liste.SubItems(17) = Cells(i, 18).Value 'Notes
Liste.SubItems(18) = Cells(i, 19).Value 'Notes
Liste.SubItems(19) = Format(Cells(i, 20).Value, "£#,##0.00")
Liste.SubItems(20) = Cells(i, 21).Value
Liste.SubItems(21) = Cells(i, 22).Value
Liste.SubItems(22) = Cells(i, 23).Value
Liste.SubItems(23) = Cells(i, 24).Value
Liste.SubItems(24) = Cells(i, 25).Value
TextBox22.Value = ""
On Error Resume Next
End If
Next i
On Error GoTo 0
Set Liste = Nothing
TextBox27 = ComboBox2.Text
ListView1.FullRowSelect = True '(liste elemanini seçtiginizde tüm satir seçili olur. Sadece lvwReport..(Ayrintilar) görünümünde geçerlidir
ListView1.Gridlines = True '(listeyi çizgili yapar. Bu özellik sadece lvwReport...(Ayrintilar) görünümünde geçerlidir)
TextBox21 = WorksheetFunction.Sum([I:I]) ' textbox'a toplam alir
TextBox21.Value = Format(TextBox21, "£#,##0.00")
TextBox26.Value = ""
ComboBox1.Value = ""
'CommandButtonCB2_Click
Sheets("Rapor").Select
Range("E2", Range("E65536").End(xlUp)).Select
Selection.TextToColumns Destination:=Range("E2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Sheets("DATA").Select
Range("A2", Range("A65536").End(xlUp)).Select
Sheets("invoice").Select
Selection.TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("A2").Select
Sheets("Rapor").Select
Range("A2").Select
End Sub
Kod 3 :
Sheets("Filter").Range("L2").Value = ComboBox2.Value
Filter2
Call SaveChart
UserForm1.Image24.Picture = LoadPicture(Fname)
Fname = ThisWorkbook.Path & "\temp1.gif"
Kod 4:
Private Sub SaveChart()
Dim MyChart As Chart
Dim Fname As String
Set MyChart = Sheets("Filter").ChartObjects(1).Chart
Fname = ThisWorkbook.Path & "\temp1.gif"
MyChart.Export Filename:=Fname, FilterName:="GIF"
End Sub
saygilar sunuyorum
Son düzenleme: