Benzersiz Listeleme

[orkuncan5]

Evren Bey sorun benden kaynaklanıyor.lvwReport ile ilgili -proje kütüphanesinde bulunamadı- mesajı gelince bende missing tick lerini kaldırmıştım.

 

[Korhan Ayhan]

Merhaba,

Evren beyin ifade ettiği sıralama problemini gidererek #6 nolu mesajımdaki kodu revize ettim. İncelermisiniz.

 

[Orion1]

Evren Bey sorun benden kaynaklanıyor.lvwReport ile ilgili -proje kütüphanesinde bulunamadı- mesajı gelince bende missing tick lerini kaldırmıştım.

oradaki listviewi kaldırıp tekrar toolbox'tan ekleyin userforma

 

[orkuncan5]

Sağolun Evren Bey hallettim

 

[halit3]

9 nolu mesajdaki kod yeniden düzenlenmiştir.

 

[1Al2Ver]

Merhaba,

Aşağıdaki kodu denermisiniz.

[COLOR="Red"]Private Sub UserForm_Initialize()[/COLOR]
    Dim WF As WorksheetFunction, Biçim As String
    Dim Hücre As Range, SD As Object, X As Long
 
    Application.ScreenUpdating = False
 
    Set WF = WorksheetFunction
    Set SD = CreateObject("Scripting.Dictionary")
 
    With ListView1
        [COLOR="red"].View = lvwReport[/COLOR]
        .FullRowSelect = True
        .Gridlines = True
        .LabelEdit = lvwManual
        .ListItems.Clear
        .ColumnHeaders.Clear
 
        With .ColumnHeaders
            .Add , , "BENZERSİZLER", ListView1.Width - 16
            .Add , , "SIRALAMA", 0
        End With
        
        Biçim = WF.Rept(0, 15) & "." & WF.Rept(0, 30)
 
        For Each Hücre In Range("F1:P1000")
            If Not IsEmpty(Hücre.Value) And IsNumeric(Hücre.Value) Then
                If Not SD.Exists(Hücre.Value) Then
                     SD.Add Hücre.Value, Nothing
                     X = X + 1
                    .ListItems.Add , , Hücre.Value
                    .ListItems(X).ListSubItems.Add , , Format(Hücre.Text, Biçim)
                End If
            End If
        Next
 
        .Sorted = True
        .SortKey = 1
        .SortOrder = lvwAscending
        .ColumnHeaders.Remove (2)
        .Refresh
    End With
 
    Set WF = Nothing
    Set SD = Nothing
 
    Application.ScreenUpdating = True
End Sub

Merhaba,

XP ve Ofis 2003'te sorun olmuyordu, şimdi Win7 ve Ofis 2010 kullanıyorum ve dosyayı açtığımda kırmızı işaretli satırlarda hata alıyorum,

Hatayı gidermek adına yapılması gerekenleri rica ediyorum,

Teşekkür ederim.

 

[1Al2Ver]

Merhaba,

XP ve Ofis 2003'te sorun olmuyordu, şimdi Win7 ve Ofis 2010 kullanıyorum ve dosyayı açtığımda kırmızı işaretli satırlarda hata alıyorum,

Hatayı gidermek adına yapılması gerekenleri rica ediyorum,

Teşekkür ederim.

Konuyu güncelliyorum,

Teşekkür ederim.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki bölümü 1 nolu bölümü 2 nolu bölüm gibi düzeltip deneyin.

1-)

[/COLOR]
[COLOR=black].View = lvwReport[/COLOR]
[COLOR=black]

2-)

[COLOR=black].View = 2[/COLOR]
[COLOR=black]

[/COLOR]

 

[platform]

Birden fazla Excel sayfasını tek sayfada toplamak

Örneğin bir excel tablosunda 1 den 150 kadar sayfa var bu sayfalarda bilgiler biçim bakımından aynı. Yeni Bir excel sayfası açıp diger sayfalardaki bilgileri bu sayfada alt alta nasıl toplarım. Örnek ektedir yardımını esirgemeyen arkadaşlara teşekkür ederim. Yapılan işlemleri excel sayfasında olursa daha anlaşılır olur .Teşekkürler.

 

[1Al2Ver]

Merhaba Sayın Korhan Ayhan,

İlginiz için teşekkür ederim,

Yanlış uygulamaya çalışmış ta olabilirim, anılan yere 2 yazmaya çalışınca kabul etmiyor

.View = lvwReport yerine .View = 2 yazarak denedim ve aşağıdaki mesajı aldım ;

Tekrar teşekkür ederim.

 

[Korhan Ayhan]

Merhaba,

Kod penceresini açın.
TOOLS-REFERENCES menüsünden "MISSING" ile başlayan referansların çentiğini kaldırıp deneyin.

 

[1Al2Ver]

Merhaba,

Kod penceresini açın.
TOOLS-REFERENCES menüsünden "MISSING" ile başlayan referansların çentiğini kaldırıp deneyin.

Merhaba Sayın Korhan Ayhan,

Önerileriniz doğrultusunda işlemleri gerçekleştirdim, ancak sonuç alamadım.

Halen anılan satıra 2 yazamıyorum.

Zaman bulduğunuzda revize edilmiş 2010 da çalışan kodu eklerseniz, References ayarlarında olması yada olmaması gerekenleri de belirtebilir seniz memnun olurum,

Teşekkür ederim.