Benzer kayıtları bulma...

Katılım
7 Mayıs 2006
Mesajlar
113
Excel Vers. ve Dili
Microsoft Office Excel 2010 TR
Altın Üyelik Bitiş Tarihi
28.03.2023
Acıklama kısmında bulunan 16 hanelı rakamı baz alarak; baz alınan satır borc ıse alacagı, alacak ıse borcu bulabılırmıyız, yanı gırdı varsa cıktısna bakıcak sekılde ve bunun lıstesını alt alta borc satırının altna alacak satırı gelebılecek sekılde lıstesı. Dıger bı durum ıse, karsılık olmayanları lıstelemesı alabılmek. Elımde 35000 satıra yakın bı data var ısın ıcınden cıkamadım tesekkurler sımdıden...dosyayı ekledım ekte.
 

Ekli dosyalar

Katılım
7 Mayıs 2006
Mesajlar
113
Excel Vers. ve Dili
Microsoft Office Excel 2010 TR
Altın Üyelik Bitiş Tarihi
28.03.2023
Acıklama kısmında bulunan 16 hanelı rakamı baz alarak; baz alınan satır borc ıse alacagı, alacak ıse borcu bulabılırmıyız, yanı gırdı varsa cıktısna bakıcak sekılde ve bunun lıstesını alt alta borc satırının altna alacak satırı gelebılecek sekılde lıstesı. Dıger bı durum ıse, karsılık olmayanları lıstelemesı alabılmek. Elımde 35000 satıra yakın bı data var ısın ıcınden cıkamadım tesekkurler sımdıden...dosyayı ekledım ekte.
 

Ekli dosyalar

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,371
Excel Vers. ve Dili
Ofis 365 Türkçe
Borç Alacak Karşılaştırması

Merhaba,

Aşağıdaki kodlar işinizi görür mü?

Kod:
Sub Karsilastir()
Dim i, SonSatir As Long
Dim j As Integer
Dim c As Range
Dim Eleman, Aranan As String
SonSatir = [A65536].End(3).Row
Application.ScreenUpdating = False
[F:F].ClearContents
Columns("F:F").NumberFormat = "@"
For i = 2 To SonSatir
    Aranan = ""
    Eleman = Split(Cells(i, "E"), " ")
    
    For j = 0 To UBound(Eleman)
        If IsNumeric(Trim(Eleman(j))) = True And _
            Len(Trim(Eleman(j))) = 16 Then
            Aranan = Eleman(j)
            Exit For
        End If
    Next j
        
    With Range("E" & i + 1 & ":E" & SonSatir)
        Set c = .Find(Aranan, LookIn:=xlValues)
        If Not c Is Nothing Then
            Cells(c.Row, "F") = Aranan
            Cells(i, "F") = Aranan
        End If
    End With
        
Next i
Range("A2:F" & SonSatir).Sort Key1:=[A2], Key2:=[F2]
[F:F].ClearContents
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır, Kolay Gelsin......", vbOKOnly, "[URL="http://www.excel.web.tr"]www.excel.web.tr[/URL]"
End Sub
 

Ekli dosyalar

Son düzenleme:
Katılım
7 Mayıs 2006
Mesajlar
113
Excel Vers. ve Dili
Microsoft Office Excel 2010 TR
Altın Üyelik Bitiş Tarihi
28.03.2023
Benzer Kayıtları Bulma

Necdet Bey cok tesekkur ederım. Sunmus oldugunuz cozum ısıme yaradı yalnız orjınal dosyadakı sutunlar fazla oldugundan dolayı macro yu kopyalayıp yapıstırdıgımda calısmıyor. Ekte son seklını gonderıyorum. Yaptıklarınıza ek olarak bır rıcam daha var karsılık bulunanları ayrı ayrı renkte gosterebılır mıyız (ılk borc alacak "sarı" ıkıncı borc alacak "kırmızı" ucuncu borc alacak "sarı") ve karsılık olmayanların S sutununda ılgılı satırın yanına herhangı bır ısaret koyabılırmıyız fıltrelemede sadece onları gorebılmek ıcın. Yardımlarınız ve sunmus oldugunuz cozumler ıcın tekrar cok tesekkur ederım.
 

Ekli dosyalar

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,371
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Sizin ilk eklediğiniz dosyada Karşılığı olan ve olmayan olarak 2 sayfa vardı. Buna benzer bir soru geleceğini tahmin ettiğim için karşılığı olanları Var, karşılığı olmayanları Yok sayfasına da yazdırdım. Ama sorunuzla beni ters köşeye yatırdınız :)

İsterseniz önce aşağıdaki kodları deneyiniz olmazsa renklendirmeyi yaparız.

Sizin aracılığınız sayesinde de bir sıkıntımı tüm arkadaşlara iletmek istiyorum. Sanırım benim gibi düşünen çok uzman arkadaşım vardır. Örnek dosyanız sizin asıl dosyanıza benzemeli, basit olarak hazırlayıp çözümü aldığınızda tıpkı sizde olduğu gibi asıl dosyanıza uygulayamıyorsunuz. Nedeni de kolonların farklı yerlerde olması.

Ben artık böyle soruları yanıtlamayacağım. İlk soruya verilen yanıttan başka aynı soruyu tekrar bakmayacağım.
 

Ekli dosyalar

Katılım
7 Mayıs 2006
Mesajlar
113
Excel Vers. ve Dili
Microsoft Office Excel 2010 TR
Altın Üyelik Bitiş Tarihi
28.03.2023
Merhaba,

Hangı koseye atacıgımı bıldınız :) desem cok tesekkurler elınıze emegınıze sağlık. tam olarak ıstedıgım buydu. buyuk bı ıs yukunden kurtardınız tekrar cok tesekkurler...
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,371
Excel Vers. ve Dili
Ofis 365 Türkçe
Güle güle kullanınız.
 
Üst