Soru Tekrarlayan Tanım Verilerini , tekrarlamayan tanımın tek satırına getirme yardımlarınızı bekliyorum:))

[aydaydogan]

Merhabalar;

Ekteki dosyada sayfa 1 ve sayfa 2 sekmeleri bulunuyor, sayfa 1de bulunan tanım kısmında tekrarlayan tanım bulunmaktadır.

Bunun verilerini sayfa 2de bulunan tekrarlamayan tanımın tek satırına hücrenin içinde alt alta olacak şekilde getirmek istiyorum.

Tekrarlamayan satırdakinin de diret aynısı getirmek istiyorum. Yapılmış halini ekte bulunan dosyada koydum.

Bu arada bu sayfa 1 ve sayfa 2 farklı exceller aslında.

Şimdiden teşekkürler.

 

[dEdE]

Merhaba,
Aşağıdaki kodu örnek dosyanızda bir modüle yapıştırarak dener misiniz?

Sub Tekrarsiz()
Dim myArr, myList As Variant
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
    ss = s1.Cells(Rows.Count, "A").End(3).Row
    myArr = s1.Range("A2:A" & ss)
    Set myList = CreateObject("System.Collections.ArrayList")
    For i = 1 To UBound(myArr)
       If Not myList.Contains(myArr(i, 1)) Then myList.Add myArr(i, 1)
    Next
s2.Range("A2:B" & s2.Cells(Rows.Count, "B").End(3).Row + 1) = ""
Satır = 2
For k = 0 To myList.Count - 1
    T = ""
    For j = 2 To ss
        If myList(k) = s1.Cells(j, 1) Then
            T = T & Chr(10) & s1.Cells(j, 2).Value
        End If
    Next j
    s2.Cells(Satır, 1) = myList(k)
    T = Right(T, Len(T) - 1)
    s2.Cells(Satır, 2) = T
    Satır = Satır + 1
Next k
End Sub

 

[aydaydogan]

Çok teşekkürler tam anlatmak istediğim gibi çalışıyor, bakalım 40 bin satırda arayıp 20 bin satıra nasıl olacak uygularken ne kadar zaman alacak ya da excel patlıycak mı

 

[serhat67]

Merhaba,
Aşağıdaki kodu örnek dosyanızda bir modüle yapıştırarak dener misiniz?

Sub Tekrarsiz()
Dim myArr, myList As Variant
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
    ss = s1.Cells(Rows.Count, "A").End(3).Row
    myArr = s1.Range("A2:A" & ss)
    Set myList = CreateObject("System.Collections.ArrayList")
    For i = 1 To UBound(myArr)
       If Not myList.Contains(myArr(i, 1)) Then myList.Add myArr(i, 1)
    Next
s2.Range("A2:B" & s2.Cells(Rows.Count, "B").End(3).Row + 1) = ""
Satır = 2
For k = 0 To myList.Count - 1
    T = ""
    For j = 2 To ss
        If myList(k) = s1.Cells(j, 1) Then
            T = T & Chr(10) & s1.Cells(j, 2).Value
        End If
    Next j
    s2.Cells(Satır, 1) = myList(k)
    T = Right(T, Len(T) - 1)
    s2.Cells(Satır, 2) = T
    Satır = Satır + 1
Next k
End Sub

Hocam merhaba;

Bende konuyu açan arkadaşımızdan özürlerimi sunarak konusu üzerinden bir soru sormak istiyorum.

Çalıştığım yerde bir denklem kurmamız gerekiyor. Kendim yol inşaatında çalışıyorum. Günlük rapor için kuracağımız denklem büyük kolaylık sağlayacaktır bize.

=G27:N28;1

Bu denkleme göre anlayacağınız üzere bu satırlardan en yüksek olanı seçmesini istedim. Buna göre 3 numaralı kısmı seçip tabloya aktardı ama ben tablo da yer alan başka değeri de seçmiş olduğu bu 3 numarayı girmesini istiyorum. Yani Resim 1'deki sorunumu =G27:N28;1 şu denkleme göre çözdüm ama ben istiyorum ki resim 2'de de 3. numarayı seçsin. Atıyorum resim 1'de 4. kısım en büyük değer çıkıp bunu seçti. Buna göre resim 2'de de 4 numarayı seçsin.

Resim 1 (Resmi yükleyemediğim için hızlı resim sitesine yükleyip linkini atıyorum lütfen yanlış anlamayın.)
Resim 2

Umarım anlatabilmişimdir En yakın zaman da siz yazdığınız için size yazdım kusura bakmayın. Bunu çözmem lazım yoksa uyku yok.

Şimdiden teşekkür ederim hocam.

 

[dEdE]

... 40 bin satırda arayıp 20 bin satıra nasıl olacak uygularken ...

Bu durumda küçük bir dokunuş biraz daha hızlandırır.
Kodların başına iki satır

Dim myArr, myList As Variant
On Error GoTo 10 'bu ve
Application.ScreenUpdating = False'bu satırı ekleyelim
Set s1 = Sheets("Sayfa1")

Sonuna da;

Next k
10 Application.ScreenUpdating = False' bu satırı ekleyelim.
End Sub

 

[dEdE]

Bende konuyu açan arkadaşımızdan özürlerimi sunarak konusu üzerinden bir soru sormak istiyorum.

Merhaba,
Forumumuza Hoş geldiniz.
Eklediğiniz resimleri inceledim. Ancak ne yapmak istediğinizi anlamadım. Sizin için basit olan konu, konuyu bilmeyen bizler için anlaşılmaz olabiliyor.
Önerim;
- Soru için yeni bir başlık açmanız
- Örnek dosya hazırlayarak sorunun ne olduğunu ve çözümden ne beklediğinizi birkaç örnekle açıklamanız
- Dosyanızı dosya paylaşım sitelerinden birine yükleyerek linkini paylaşmanız olacaktır.
Hoşça kalın.