Havuzdan Veri Çekme Hakkında

[0oMURATo0]

Arkadaşlar Ekli dosyadaki makroda havuzdan veri çekebiliyorum fakat aynı numaraya sahip dataların karışmaması için hizalı bir şekilde çekilmesini istiyorum.. Ekli dosyada daha net açıkladım.. Yardımcı olabilecek varsa çok memnun olurum..

Saygılar,

 

[0oMURATo0]

Bi çözümü yokmudur arkadaşlar?

 

[Muzaffer Ali]

sorunuz hiç anlaşılır değil.

 

[0oMURATo0]

Dosyayı yeniden düzenledim istediğim şekli boyalı alanda belirttim.. Umarım anlatabilmişimdir.. Yardımlarınızı bekliyorumm...

 

[Korhan Ayhan]

Merhaba,

"makro1" isimli makronuzu aşağıdaki gibi değiştirip deneyin.

Sub makro1()
    Dim BUL As Range, ADRES As String
    Call temizlee
    Application.ScreenUpdating = False
    On Error Resume Next
    Set S1 = ThisWorkbook.Worksheets("sonuç")
    Set S2 = ThisWorkbook.Worksheets("veri")
    
    For i = 2 To S1.Range("A65536").End(xlUp).Row
        Set BUL = S2.Range("A:A").Find(S1.Cells(i, 1), , , xlWhole)
        If Not BUL Is Nothing Then
        ADRES = BUL.Address
        If sonsatir = 0 Then sonsatir = i
            Do
                S1.Cells(sonsatir, 2) = S2.Cells(BUL.Row, 1)
                S1.Cells(sonsatir, 3) = S2.Cells(BUL.Row, 2)
                S1.Cells(sonsatir, 4) = S2.Cells(BUL.Row, 3)
                S1.Cells(sonsatir, 5) = S2.Cells(BUL.Row, 4)
                S1.Cells(sonsatir, 6) = S2.Cells(BUL.Row, 5)
                S1.Cells(sonsatir, 7) = S2.Cells(BUL.Row, 6)
                S1.Cells(sonsatir, 8) = S2.Cells(BUL.Row, 7)
                S1.Cells(sonsatir, 9) = S2.Cells(BUL.Row, 9)
                S1.Cells(sonsatir, 10) = S2.Cells(BUL.Row, 10)
                S1.Cells(sonsatir, 11) = S2.Cells(BUL.Row, 11)
                S1.Cells(sonsatir, 12) = S2.Cells(BUL.Row, 12)
                S1.Cells(sonsatir, 13) = S2.Cells(BUL.Row, 13)
                S1.Cells(sonsatir, 14) = S2.Cells(BUL.Row, 14)
                S1.Cells(sonsatir, 15) = S2.Cells(BUL.Row, 17)
                S1.Cells(sonsatir, 16) = S2.Cells(BUL.Row, 23)
                S1.Cells(sonsatir, 17) = S2.Cells(BUL.Row, 34)
                S1.Cells(sonsatir, 18) = S2.Cells(BUL.Row, 35)
                sonsatir = sonsatir + 1
                Set BUL = S2.Range("A:A").FindNext(BUL)
            Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        Else
            sonsatir = sonsatir + 1
        End If
    Next i
    
    For i = 2 To S1.Range("b65536").End(xlUp).Row
        say = WorksheetFunction.CountIf(Range("b:b"), S1.Cells(i, 1))
        If say > 1 Then
            S1.Range("a" & i + 1 & ":a" & i + say - 1).Insert
        End If
    Next
    
    Application.ScreenUpdating = True
    MsgBox "İşlem TAMAM.", vbInformation
End Sub

 

[*Freeman*]

Korhan Bey, elinize sağlık güzel bir paylaşım olmuş...

 

[0oMURATo0]

Korhan Bey ilginize teşekkür ederim tam istediğim gibi düzenlemişsiniz.. Fakat birkaç deneme yapınca bir sorunla karşılaştım.. Veri havuzunda olmayan bir numara yazarak arama yaptığımız zaman sırada kayma oluyor. Bunu engelleyebilirmiyiz acaba?

 

[Korhan Ayhan]

Merhaba,

Üstteki mesajımda ki kodu yeniledim. Tekrar dener misiniz?

 

[0oMURATo0]

Korhan hocam teşekkürler programda son bir sıkıntı kaldı aynı numaraya sahip 2 data olduğunda düzgün çalışıyor fakat 2 den fazla olduğu zaman program düzgün cevap vermiyor. ilk yolladığım dosyada böyle bir sorun yoktu. Yaşanan sorunun net anlaşılması için örnek dosya ekledim.. Yardımlarınızı bekliyorumm..

Saygılar,

 

[Levent Menteşoğlu]

İlgili satıra aşağıdaki kırmızı renkli kısmı ekleyin.

S1.Range("a" & i + 1 & ":a" & i + say - 1).Insert [COLOR=Red]Shift:=xlDown[/COLOR]

 

[0oMURATo0]

hocam eyvallah bütün gün uğraştm işin içinden cıkamamıştım meğer 2 kelimeye bakıyormuş bu program 280 binlik bir datada bir veriyi yaklaşık 7 saniyede buluyor bunu hızlandırmak mümkünmüdür acaba?

 

[Levent Menteşoğlu]

hocam eyvallah bütün gün uğraştm işin içinden cıkamamıştım meğer 2 kelimeye bakıyormuş bu program 280 binlik bir datada bir veriyi yaklaşık 7 saniyede buluyor bunu hızlandırmak mümkünmüdür acaba?

Korhan bey zaten find komutu ile en hızlı kodlamayı kullanmış. Başka çözüm zor gibi.

 

[0oMURATo0]

Anladım hocam hepinize emeğinizden dolayı çok teşekkür ediyorumm..

İyi çalışmalar,