• DİKKAT

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

Listview basligina tiklayip sayfada siralama

  • Konbuyu başlatan Konbuyu başlatan lapot
  • Başlangıç tarihi Başlangıç tarihi
lapot' Alıntı:
I have tried this but no luck, am I missing someting
Genişletmek için tıkla ...
...............................:)
Genel mantık böyle olmalı ama ben 2003 ofis kullanıyorum. Dosyanızdaki referanslar dosyanızı açmamı engelliyor. Satır satır deneyerek kodları kendinize uyarlarsanız (özellikle sıralama kodlarını) sonuç alabilirsiniz.
 
Son düzenleme:
alicimri' Alıntı:
...............................:)
Genel mantık böyle olmalı ama ben 2003 ofis kullanıyorum. Dosyanızdaki referanslar dosyanızı açmamı engelliyor. Satır satır deneyerek kodları kendinize uyarlarsanız (özellikle sıralama kodlarını) sonuç alabilirsiniz.
Genişletmek için tıkla ...


Cok tesekkur ederim ilginize. Pazartesi deneyecegim dediklerinizi.
 
#12 nolu mesajın mavi renkli kodlarını değiştirdim. User form2 de kodları yeni bir excel dosyasına kopyaladım ve #12 mesajdaki kodları ekleyerek, denedim. DATA sayfasındaki sütunları küçükten büyüğe sıralıyor.
 
alicimri' Alıntı:
#12 nolu mesajın mavi renkli kodlarını değiştirdim. User form2 de kodları yeni bir excel dosyasına kopyaladım ve #12 mesajdaki kodları ekleyerek, denedim. DATA sayfasındaki sütunları küçükten büyüğe sıralıyor.
Genişletmek için tıkla ...

Sıralama tek sütunda yapılıp, diğer sütunlar aynı kalacaksa kodlardaki mavi satırları silin. Sıralama bütün sutunlara genişletilecekse kırmızı satırları silin.
'Eğer tek sütunda sıralama yapulcaksa
sat = ListView1.ListItems.Count + 1
sut = ColumnHeader.Index
adres = Replace(Range(Cells(1, sut), Cells(sat, sut)).Address, "$", "")
bas = Replace(Cells(2, sut).Address, "$", "")
'Eğer Sıralama bütün sutunlara genişletilecekse
adres = Range("A1").CurrentRegion.Address
bas = "A2"
Range(adres).Sort Key1:=Range(bas), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub


12 nolu mesajdaki kodlari denedim fakat hala siralamayi yapmiyor? benmi bir yerde yanlis yapiyorum acaba?

saygilar
 
Sıralama Data sayfasında mı yapılacak Listview'demi yapılacak. İşlem yapmıyorsa hata vermiyor mu?
 
alicimri' Alıntı:
Sıralama Data sayfasında mı yapılacak Listview'demi yapılacak. İşlem yapmıyorsa hata vermiyor mu?
Genişletmek için tıkla ...

ikisindede ayni anda yapacak , Listview sayfasinda basliga tiklayinca hem lisview'de siralama hem de excel sayfasinda ayni anda siralama yapmasini istiyorum, su and hic birsey yapmiyor, hata dahi vermiyor.
 
Denedim hem Formda sayfada çalışıyor.
Kod: 
Private Sub ListView2_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
 sut = ColumnHeader.Index
adres = Range("A1").CurrentRegion.Address
bas = Replace(Cells(2, sut).Address, "$", "")
  Range(adres).Sort Key1:=Range(bas), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    With ListView2
        .SortKey = ColumnHeader.Index - 1
            .SortOrder = lvwAscending
        .Sorted = True
    End With
End Sub
 
alicimri' Alıntı:
Denedim hem Formda sayfada çalışıyor.
Kod: 
Private Sub ListView2_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
 sut = ColumnHeader.Index
adres = Range("A1").CurrentRegion.Address
bas = Replace(Cells(2, sut).Address, "$", "")
  Range(adres).Sort Key1:=Range(bas), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    With ListView2
        .SortKey = ColumnHeader.Index - 1
            .SortOrder = lvwAscending
        .Sorted = True
    End With
End Sub
Genişletmek için tıkla ...


harika calisti , bir tek tarihte dogru siralama yapmiyor. Ayrica A dan Z ye siraliyor , ikinci tiklamada Z den A ya siralatabilirmiyiz?

tesekkurler
 
Kusura bakmayın aceleye geldi ve karışık oldu ama iş görüyor.
1-Forma bir Metin Kutusu daha ekleyin, Bunun Visible özelliğini False yaparak gizleyin.
2- Formun Intalize olayının en sonuna aşağıdaki kodu ekleyin.
Kod: 
 TextBox2.Value = True
ListView2_ColumnClick olayına ise aşağıdaki kodu yazın
Kod: 
Private Sub ListView2_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
sut = ColumnHeader.Index
adres = Range("A1").CurrentRegion.Address
bas = Replace(Cells(2, sut).Address, "$", "")
Dim ord As Boolean
If TextBox2.Value = True Then
  Range(adres).Sort Key1:=Range(bas), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
          With ListView2
        .SortKey = ColumnHeader.Index - 1
            .SortOrder = lvwAscending
        .Sorted = True
    End With
TextBox2.Value = False
Else
  Range(adres).Sort Key1:=Range(bas), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 With ListView2
        .SortKey = ColumnHeader.Index - 1
            .SortOrder = lvwDescending
        .Sorted = True
    End With
TextBox2.Value = True
End If
End Sub
 
alicimri' Alıntı:
Kusura bakmayın aceleye geldi ve karışık oldu ama iş görüyor.
1-Forma bir Metin Kutusu daha ekleyin, Bunun Visible özelliğini False yaparak gizleyin.
2- Formun Intalize olayının en sonuna aşağıdaki kodu ekleyin.
Kod: 
 TextBox2.Value = True
ListView2_ColumnClick olayına ise aşağıdaki kodu yazın
Kod: 
Private Sub ListView2_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
sut = ColumnHeader.Index
adres = Range("A1").CurrentRegion.Address
bas = Replace(Cells(2, sut).Address, "$", "")
Dim ord As Boolean
If TextBox2.Value = True Then
  Range(adres).Sort Key1:=Range(bas), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
          With ListView2
        .SortKey = ColumnHeader.Index - 1
            .SortOrder = lvwAscending
        .Sorted = True
    End With
TextBox2.Value = False
Else
  Range(adres).Sort Key1:=Range(bas), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 With ListView2
        .SortKey = ColumnHeader.Index - 1
            .SortOrder = lvwDescending
        .Sorted = True
    End With
TextBox2.Value = True
End If
End Sub
Genişletmek için tıkla ...


super calisti fakat C sutununda dogru siralama yapmiyor. Resim ekledim acaba sayi formatlarimi farkli?

saygilar
 

Ekli dosyalar

  • Capture sort.JPG
    Capture sort.JPG
    90.7 KB · Görüntüleme: 1
viewlistin bilgi alış şekli size uygunsa. Birde böyle deneyin. Her Başlığa tıkladıkça viewlist i yeniliyor.
Kod: 
Private Sub ListView2_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
sut = ColumnHeader.Index
adres = Range("A1").CurrentRegion.Address
bas = Replace(Cells(2, sut).Address, "$", "")
Dim ord As Boolean
If TextBox2.Value = True Then
  Range(adres).Sort Key1:=Range(bas), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
       
TextBox2.Value = False
Else
  Range(adres).Sort Key1:=Range(bas), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
TextBox2.Value = True
End If
Me.ListView2.ListItems.Clear
With Me.ListView2
    .HideColumnHeaders = False
    .View = lvwReport
End With
Dim wksSource As Worksheet
Dim rngData As Range
Dim rngCell As Range
Dim LstItem As ListItem
Dim RowCount As Long
Dim ColCount As Long
Dim i As Long
Dim j As Long
Set wksSource = Worksheets("DATA")
Set rngData = wksSource.Range("A1").CurrentRegion

RowCount = rngData.Rows.Count
ColCount = rngData.Columns.Count
For i = 2 To RowCount
    Set LstItem = Me.ListView2.ListItems.Add(Text:=rngData(i, 1).Value)
    For j = 2 To ColCount
           If j >= 9 And j <= 17 Or j >= 20 And j <= 25 Then
        LstItem.ListSubItems.Add Text:=Format(rngData(i, j).Value, "£##,##0.00")
        Else
         LstItem.ListSubItems.Add Text:=rngData(i, j).Value
         End If
    Next j
Next i
End Sub

Private Sub UserForm_Activate()
With Me.ListView2
    .HideColumnHeaders = False
    .View = lvwReport
End With
Dim wksSource As Worksheet
Dim rngData As Range
Dim rngCell As Range
Dim LstItem As ListItem
Dim RowCount As Long
Dim ColCount As Long
Dim i As Long
Dim j As Long
Set wksSource = Worksheets("DATA")
Set rngData = wksSource.Range("A1").CurrentRegion
For Each rngCell In rngData.Rows(1).Cells
    Me.ListView2.ColumnHeaders.Add Text:=rngCell.Value, Width:=90
Next rngCell
RowCount = rngData.Rows.Count
ColCount = rngData.Columns.Count
For i = 2 To RowCount
    Set LstItem = Me.ListView2.ListItems.Add(Text:=rngData(i, 1).Value)
    For j = 2 To ColCount
    If j >= 9 And j <= 17 Or j >= 20 And j <= 25 Then
        LstItem.ListSubItems.Add Text:=Format(rngData(i, j).Value, "£##,##0.00")
        Else
         LstItem.ListSubItems.Add Text:=rngData(i, j).Value
         End If
    Next j
Next i
TextBox2.Value = True
End Sub
 
Son düzenleme:
harikasin arkadasim, gercekten nasil yaptin bilmiyorum ama super bir zeka.

son birsey daha para degerleri sayilarda bozuldu bende Pound isareti vardi ama su an resimdeki sekle dondu bunuda cozebilirseniz ne kadar tesekkur etsem azdir.
 

Ekli dosyalar

  • Capture currency.JPG
    Capture currency.JPG
    42.6 KB · Görüntüleme: 4
Dosya indiremiyorum
1- £ işareti başta mı sonda mı
2- Ondalık hanesi var mı
3- Excel sayfasında kaçıncı sütunda.
 
isaret basinda olacak yani su sekilde

5 pound - £5.00
100 pound - £100.00
1000 Pound - £1,000.00 seklinde

excel sayfasinda I stunundan Q sutununa kadar hep sayi, R ile S yazi , tekrar T den Y ye sayi

mumkunmu acaba?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst