Bul > Altına Ekle ve Kalanları Birleştir

RBozkurt

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
726
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
@Ömer bey tekrardan merhaba. Biraz vakit geçti üzerinden 1 noktada eksiklik var işlerden dolayı dönüş yapamamıştım.
Düzeltilmesi konusunda yardımınıza ihtiyacım var.
11 ve 15 numaralı mesajlardaki kod çalışıyor. TC kısmını fark etmemişim o gün.
Liste oluşuyor; adresler ve doğum tarihleri kişilere ait ama TC sütunun hep 1. TC yi sabit alıyor.
Nasıl düzeltebilirim. Yada hangi satırı düzeltmek gerekir.
Teşekkür ederim.

Adsız.png
 
Ömer

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Deneyiniz.
Kod: 
Sub tc_bul_yeni()

    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, son As Long
    Dim i As Long, c As Range, Adr As String, sat As Long, j As Long, s As Long, k As Integer

    Set S1 = Sheets("NetcadRapor")
    Set S2 = Sheets("MernisListe")
    Set S3 = Sheets("ÖnÇalışma")
    son = S2.Cells(Rows.Count, "G").End(xlUp).Row
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    S3.Rows("2:" & Rows.Count).Clear
 
    sat = 2
    For i = 2 To S1.Cells(Rows.Count, "F").End(xlUp).Row
        Set c = S2.[G:G].Find(S1.Cells(i, "L"), , xlValues, xlWhole)
        If Not c Is Nothing And S1.Cells(i, "L") <> "" Then
            For j = c.Row To son
                If s = 0 Then s = sat
                If Len(S2.Cells(j, "G")) <> 11 Then
                    Exit For
                End If
                S3.Cells(sat, "C") = S1.Cells(i, "A")
                S3.Cells(sat, "D") = S1.Cells(i, "B")
                S3.Cells(sat, "E") = S1.Cells(i, "C")
                S3.Cells(sat, "H") = S2.Cells(j, "B")
                S3.Cells(sat, "I") = S2.Cells(j, "C")
                S3.Cells(sat, "F") = S1.Cells(i, "D")
                S3.Cells(sat, "G") = S1.Cells(i, "E")
                S3.Cells(sat, "J") = S1.Cells(i, "H")
                S3.Cells(sat, "K") = S1.Cells(i, "I")
                S3.Cells(sat, "L") = S1.Cells(i, "J")
                S3.Cells(sat, "M") = S1.Cells(i, "K")
                S3.Cells(sat, "T") = S2.Cells(j, "G")
                S3.Cells(sat, "U") = S2.Cells(j, "F")
                S3.Cells(sat, "V") = S2.Cells(j, "H")
                S3.Cells(sat, "W") = S2.Cells(j, "I")
                sat = sat + 1
            Next j
            For k = 3 To 13
                If k < 8 Or k > 9 Then
                    S3.Cells(s, k).Resize(sat - s, 1).MergeCells = True
                    S3.Cells(s, k).Resize(sat - s, 1).VerticalAlignment = xlCenter
                End If
            Next k
            s = 0
        Else
            S3.Cells(sat, "C") = S1.Cells(i, "A")
            S3.Cells(sat, "D") = S1.Cells(i, "B")
            S3.Cells(sat, "E") = S1.Cells(i, "C")
            S3.Cells(sat, "H") = S1.Cells(i, "F")
            S3.Cells(sat, "I") = S1.Cells(i, "G")
            S3.Cells(sat, "F") = S1.Cells(i, "D")
            S3.Cells(sat, "G") = S1.Cells(i, "E")
            S3.Cells(sat, "J") = S1.Cells(i, "H")
            S3.Cells(sat, "K") = S1.Cells(i, "I")
            S3.Cells(sat, "L") = S1.Cells(i, "J")
            S3.Cells(sat, "M") = S1.Cells(i, "K")
            S3.Cells(sat, "T") = S1.Cells(i, "L")
            sat = sat + 1
        End If
        sat = sat + 1
    Next i
 
    S3.Select
    Range("A2:AD" & sat - 2).Borders.LineStyle = 1

    MsgBox "Aktarım Tamamlandı.", vbInformation
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub
 
RBozkurt

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
726
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
Ömer' Alıntı:
Deneyiniz.
Kod: 
Sub tc_bul_yeni()

    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, son As Long
    Dim i As Long, c As Range, Adr As String, sat As Long, j As Long, s As Long, k As Integer

    Set S1 = Sheets("NetcadRapor")
    Set S2 = Sheets("MernisListe")
    Set S3 = Sheets("ÖnÇalışma")
    son = S2.Cells(Rows.Count, "G").End(xlUp).Row

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    S3.Rows("2:" & Rows.Count).Clear

    sat = 2
    For i = 2 To S1.Cells(Rows.Count, "F").End(xlUp).Row
        Set c = S2.[G:G].Find(S1.Cells(i, "L"), , xlValues, xlWhole)
        If Not c Is Nothing And S1.Cells(i, "L") <> "" Then
            For j = c.Row To son
                If s = 0 Then s = sat
                If Len(S2.Cells(j, "G")) <> 11 Then
                    Exit For
                End If
                S3.Cells(sat, "C") = S1.Cells(i, "A")
                S3.Cells(sat, "D") = S1.Cells(i, "B")
                S3.Cells(sat, "E") = S1.Cells(i, "C")
                S3.Cells(sat, "H") = S2.Cells(j, "B")
                S3.Cells(sat, "I") = S2.Cells(j, "C")
                S3.Cells(sat, "F") = S1.Cells(i, "D")
                S3.Cells(sat, "G") = S1.Cells(i, "E")
                S3.Cells(sat, "J") = S1.Cells(i, "H")
                S3.Cells(sat, "K") = S1.Cells(i, "I")
                S3.Cells(sat, "L") = S1.Cells(i, "J")
                S3.Cells(sat, "M") = S1.Cells(i, "K")
                S3.Cells(sat, "T") = S2.Cells(j, "G")
                S3.Cells(sat, "U") = S2.Cells(j, "F")
                S3.Cells(sat, "V") = S2.Cells(j, "H")
                S3.Cells(sat, "W") = S2.Cells(j, "I")
                sat = sat + 1
            Next j
            For k = 3 To 13
                If k < 8 Or k > 9 Then
                    S3.Cells(s, k).Resize(sat - s, 1).MergeCells = True
                    S3.Cells(s, k).Resize(sat - s, 1).VerticalAlignment = xlCenter
                End If
            Next k
            s = 0
        Else
            S3.Cells(sat, "C") = S1.Cells(i, "A")
            S3.Cells(sat, "D") = S1.Cells(i, "B")
            S3.Cells(sat, "E") = S1.Cells(i, "C")
            S3.Cells(sat, "H") = S1.Cells(i, "F")
            S3.Cells(sat, "I") = S1.Cells(i, "G")
            S3.Cells(sat, "F") = S1.Cells(i, "D")
            S3.Cells(sat, "G") = S1.Cells(i, "E")
            S3.Cells(sat, "J") = S1.Cells(i, "H")
            S3.Cells(sat, "K") = S1.Cells(i, "I")
            S3.Cells(sat, "L") = S1.Cells(i, "J")
            S3.Cells(sat, "M") = S1.Cells(i, "K")
            S3.Cells(sat, "T") = S1.Cells(i, "L")
            sat = sat + 1
        End If
        sat = sat + 1
    Next i

    S3.Select
    Range("A2:AD" & sat - 2).Borders.LineStyle = 1

    MsgBox "Aktarım Tamamlandı.", vbInformation
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
End Sub
Genişletmek için tıkla ...
@Ömer bey elinize sağlık problem düzeldi. Çok teşekkür ederim.
 
RBozkurt

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
726
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
Kod: 
S3.Cells(sat, "J") = S1.Cells(i, "H")
S3.Cells(sat, "K") = S1.Cells(i, "I")
Aynı çalışmamda faklı bir işlem için K'yı iptal edip ordaki veriyide J hücresine taksimli şekilde ekleyince aşağıdaki gibi 1/1 denk gelince mesela 01.Ocak gibi tarihe çeviriyor.
Metin olarak nasıl yapabilirim. Teşekkür ederim.

Kod: 
S3.Cells(sat, "J") = S1.Cells(i, "H") & "/" & S1.Cells(i, "I")
 
Ömer

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

Deneyiniz.
Kod: 
S3.Cells(sat, "J") = "'" & S1.Cells(i, "H") & "/" & S1.Cells(i, "I")
 
RBozkurt

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
726
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
RBozkurt

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
726
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
Merhaba
Set S1 = Sheets("NetcadRapor") sayfasına sütun olarak ekleme yaptım. Aynı şekilde
Set S3 = Sheets("ÖnÇalışma") sayfasına aktarmayı denedim. Resimdeki gibi hatayı geçemedim.
Konuyla ilgili yardımcı olabilirmisiniz? Teşekkür ederim.

Kod: 
S3.Cells(sat, "B") = s1.Cells(i, "N")
S3.Cells(sat, "N") = s1.Cells(j, "O")
S3.Cells(sat, "O") = s1.Cells(j, "P")
S3.Cells(sat, "Q") = s1.Cells(j, "R")
S3.Cells(sat, "R") = s1.Cells(j, "S")
S3.Cells(sat, "S") = s1.Cells(j, "T")
Adsız.png
 
Ömer

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Bu şekilde kesin bir şey söylemem zor. Örnek dosya ekleyerek açıklayınız.
 
RBozkurt

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
726
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
Ömer' Alıntı:
Bu şekilde kesin bir şey söylemem zor. Örnek dosya ekleyerek açıklayınız.
Genişletmek için tıkla ...
@Ömer bey merhaba. Örnek dosya hazırlarken fark ettim. Kopyalarken diğer kodu almışım.
Kodlardaki j'yi i ile değiştirince düzeldi şuan. Teşekkür ederim.
 

Ekli dosyalar

RBozkurt

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
726
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
Merhabalar. Düşey arama işlemini yaparken bir üst hücre dolu ise aramaması gibi bir işlem yaptırılabilir mi?

Bir hata oluşmaktadır.
NetcadRapor sayfasındaki kişiler MernisListe sayfasında aranırken ekte eklemiş olduğum PEMBE renkli kişi mesela;
Normalde bu TC numarası X bir kişinin hissedarı ayrıca kendi adına da farklı bir ada parselde TEK hissedar.
Arama yaparken listede de anlaşılacağı üzere varis olan yeri baz alıyor. Bu sebeple diğer sayfaya aktarırken TEK hissedarı olduğu taşınmaza altındaki kişileri de aktarıyor ve hatalı veri oluşuyor.

Mernislerin karışmaması için aralarına 1er satır boşluk eklenmişti.
Mernis bloğunda ilk kişi taşınmaz sahibi. İlk veriyi aldırmak daha zor olduğunu düşünüyorum.
Biraz düşündüm en mantıklısı üst hücrede veri var ise es geçmesi gibi geldi.
 

Ekli dosyalar

RBozkurt

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
726
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
Merhaba,
30. mesajdaki hata ile ilgili yardımcı olabilir misiniz?
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst