Makroda kaydır ve son satırda sıkıntı yaşıyorum.

[Carpintero]

Merhabalar; ekli dosya ya değerli yardımlarınızı bekliyorum.


C ve K sütununu döngüye alacağız.Eşitliği halinde D E ve F sütunundaki verileri
M kolonundan itibaren son boş hücre ve kaydır (Ofset) tekniğini kullanarak yazdıracağız

indirme linki
https://www.dosyaupload.com/av6d

 

[Orion1]

Buyurun.,

Sub karsilastir()
Dim sonsat As Long, i As Long, k As Range
sonsat = Cells(Rows.Count, "C").End(xlUp).Row
Range("N:N").Clear
For i = 4 To sonsat
    Set k = Range("K:K").Find(Cells(i, "C").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        k.Offset(0, 3).Value = Cells(i, "F").Value
        k.Offset(-1, 3).Value = Cells(i, "E").Value
        k.Offset(1, 3).Value = Cells(i, "D").Value
    End If
Next i
MsgBox "İşlem tamamlandı."
End Sub

 

[Carpintero]

Sayın hocam çok teşekkür ederim alakanız için.
Yazdırılan veriler ve yerlerinde herhangi bir sorun yok.
Lakin veri yazılır iken son satır mantığı ile yazılacak.

Basitçe anlatmak gerekir ise.
Örneğimize göre;
Makro ilk çalıştığında verileri N sütununa
2. çalıştığında O sütununa
3. çalıştığında P sütununa yazacak.
Yani ilgili satırda son dolu hücreyi buldurup onun sonuna yazdıracağız.

bu şekilde revize edebilir iseniz müteşekkir olurum.
Saygılarımla.

 

[Orion1]

Ama siz dosyada örneği öyle vermemiştiniz!

 

[Orion1]

Buna göre örnek dosyanızı tekrar hazırlayıp yollarsanız bakarım.

 

[Carpintero]

Sayın Hocam açıklamalarım ile karışıklığa yol açtım sanırım.
örnek dosyamız yine aynı. C ile K kıyasladıktan sonra verilerin yerleştiği satırda da sorun yok.
Sadece yazdıracağımız veriyi N sütununa değilde ilgili satırda en son boş hücreye yazdıracağız.
Eğer N dolu ise O ya O dolu ise P ye gibi

 

[Orion1]

Örnek yollamıyorsunuz.şimdi onu yapacam öylede değil diyeceksiniz.
Peki yapıyorum ama öyle değil demiyeceksiniz.

 

[Carpintero]

yeni örnek.
https://www.dosyaupload.com/n5zG

 

[Orion1]

Buyurun.

Sub karsilastir()
Dim sonsat As Long, i As Long, k As Range, sut As Integer
sonsat = Cells(Rows.Count, "C").End(xlUp).Row
Range("N:N").Clear
For i = 4 To sonsat
    Set k = Range("K:K").Find(Cells(i, "C").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        sut = Cells(k.Row, "IV").End(xlToLeft).Column
        Cells(k.Row, sut + 1).Value = Cells(i, "F").Value
        Cells(k.Row, sut + 2).Value = Cells(i, "E").Value
        Cells(k.Row, sut + 3).Value = Cells(i, "D").Value
    End If
Next i
MsgBox "İşlem tamamlandı."
End Sub

 

[Carpintero]

8 nolu mesaj da örnek vermiştim hocam.
aynı anda yazdığımız için dikkatinizden kaçtı sanırım.

 

[Orion1]

Buyurun.

Sub karsilastir()
Dim sonsat As Long, i As Long, k As Range, sut As Integer
sonsat = Cells(Rows.Count, "C").End(xlUp).Row
For i = 4 To sonsat
    Set k = Range("K:K").Find(Cells(i, "C").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        sut = Cells(k.Row - 1, "IV").End(xlToLeft).Column
        k.Offset(-1, sut - 10).Value = Cells(i, "F").Value
        sut = Cells(k.Row, "IV").End(xlToLeft).Column
        k.Offset(0, sut - 10).Value = Cells(i, "E").Value
        sut = Cells(k.Row + 1, "IV").End(xlToLeft).Column
        k.Offset(1, sut - 10).Value = Cells(i, "D").Value
    End If
Next i
MsgBox "İşlem tamamlandı."
End Sub

 

[Carpintero]

Sayın hocam çok çok teşekkür ederim.
Fazlaca zamanınızı aldım.
Umarım farklı farklı halleri ile diğer kodlar da kullanılır.

Saygılarımla.

 

[Orion1]

Rica ederim.
İyi çalışmalar.