Cift Isimleri Bulma

senuyurken

Altın Üye
Katılım
20 Nisan 2008
Mesajlar
168
Excel Vers. ve Dili
Office 2021 TR
Altın Üyelik Bitiş Tarihi
25-06-2025
Sicil Nosuna Gore Arayip Iki Kez Avans Alan Kisileri Sayfa 2ye Avanslari Toplayarak Listelemesi Mumkunmu Acaba


Tesekkur Ederim

Ornek Dosya Ektedir
 

Necdet

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

Aşağıdaki kodları bir butona bağlayıp çalıştırabilirsiniz. Bir deneyiniz bakalım. Aman uyurken işlem yapmayınız, böyle çifter çifter avans verebilirsiniz :)


Kod:
Sub AvansBul()
Application.ScreenUpdating = False
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s2.Range("A3:C65536").ClearContents
Dim i, sn, Var, SonSat As Integer
sn = 2
SonSat = s1.[A65536].End(3).Row
For i = 3 To SonSat
    Var = Application.WorksheetFunction.CountIf(s1.Range("A3:A" & SonSat), Cells(i, "A"))
    If Var > 1 Then
        Set Bul = s2.Columns(1).Find(s1.Cells(i, "A"))
        If Bul Is Nothing Then
            sn = sn + 1
            s2.Cells(sn, "A") = s1.Cells(i, "A")
            s2.Cells(sn, "B") = s1.Cells(i, "B")
            s2.Cells(sn, "C") = s1.Cells(i, "C")
        Else
            s2.Cells(Bul.Row, "C") = s2.Cells(Bul.Row, "C") + s1.Cells(i, "C")
        End If
    End If
Next i
MsgBox "İşlem Tamamdır"
Application.ScreenUpdating = True
End Sub
 

senuyurken

Altın Üye
Katılım
20 Nisan 2008
Mesajlar
168
Excel Vers. ve Dili
Office 2021 TR
Altın Üyelik Bitiş Tarihi
25-06-2025
Merhaba,

Aşağıdaki kodları bir butona bağlayıp çalıştırabilirsiniz. Bir deneyiniz bakalım. Aman uyurken işlem yapmayınız, böyle çifter çifter avans verebilirsiniz :)


Kod:
Sub AvansBul()
Application.ScreenUpdating = False
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s2.Range("A3:C65536").ClearContents
Dim i, sn, Var, SonSat As Integer
sn = 2
SonSat = s1.[A65536].End(3).Row
For i = 3 To SonSat
    Var = Application.WorksheetFunction.CountIf(s1.Range("A3:A" & SonSat), Cells(i, "A"))
    If Var > 1 Then
        Set Bul = s2.Columns(1).Find(s1.Cells(i, "A"))
        If Bul Is Nothing Then
            sn = sn + 1
            s2.Cells(sn, "A") = s1.Cells(i, "A")
            s2.Cells(sn, "B") = s1.Cells(i, "B")
            s2.Cells(sn, "C") = s1.Cells(i, "C")
        Else
            s2.Cells(Bul.Row, "C") = s2.Cells(Bul.Row, "C") + s1.Cells(i, "C")
        End If
    End If
Next i
MsgBox "İşlem Tamamdır"
Application.ScreenUpdating = True
End Sub


ILGIN ICIN TESEKKUR EDERIM... CALISTIGIM FIRMADA FIREWALL KULLANILDIGINDAN ZIPLI DOSYALARI DOWNLOAD YAPAMIYORUZ.. MUMKUNSE NORMAL OLARAK EKLESENIZ INDIRSEM... BUTON DAHA HIC ANLAMIYORUM... FORMUL GIRILEREK YAPILABILIRMIYIM.. EXCELDE COK COK YENIYIM...


TESEKKUR EDERIM SELAMETLE
 

Necdet

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

Fonksiyonlarla da yapılabilir fakat beni hem aşar hem sıkıntıya sokar.
Bir arkadaşımız mutlaka fonksiyonlara yapılmış çözümü sunacaktır size.
 

senuyurken

Altın Üye
Katılım
20 Nisan 2008
Mesajlar
168
Excel Vers. ve Dili
Office 2021 TR
Altın Üyelik Bitiş Tarihi
25-06-2025
Merhaba,

Aşağıdaki kodları bir butona bağlayıp çalıştırabilirsiniz. Bir deneyiniz bakalım. Aman uyurken işlem yapmayınız, böyle çifter çifter avans verebilirsiniz :)


Kod:
Sub AvansBul()
Application.ScreenUpdating = False
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s2.Range("A3:C65536").ClearContents
Dim i, sn, Var, SonSat As Integer
sn = 2
SonSat = s1.[A65536].End(3).Row
For i = 3 To SonSat
    Var = Application.WorksheetFunction.CountIf(s1.Range("A3:A" & SonSat), Cells(i, "A"))
    If Var > 1 Then
        Set Bul = s2.Columns(1).Find(s1.Cells(i, "A"))
        If Bul Is Nothing Then
            sn = sn + 1
            s2.Cells(sn, "A") = s1.Cells(i, "A")
            s2.Cells(sn, "B") = s1.Cells(i, "B")
            s2.Cells(sn, "C") = s1.Cells(i, "C")
        Else
            s2.Cells(Bul.Row, "C") = s2.Cells(Bul.Row, "C") + s1.Cells(i, "C")
        End If
    End If
Next i
MsgBox "İşlem Tamamdır"
Application.ScreenUpdating = True
End Sub

VALLAHA NASIL OLDU ISE BIR BUTON YAPTIM SIMDI... MAKRO OLARAK KAYDETTIM DEDIGINIZ GIBI.... AMA DUGMEYE BASTIGIMDA ISLEM TAMAMDIR YAZISI CIKIYOR FAKAT SAYFA 2 DE HIC BIRSEY LISTELEMIYOR....


TESEKKUR EDERIMMMM
 

senuyurken

Altın Üye
Katılım
20 Nisan 2008
Mesajlar
168
Excel Vers. ve Dili
Office 2021 TR
Altın Üyelik Bitiş Tarihi
25-06-2025
Necdet Yeşertener... BU NE HIZ NE ZAMAN CEVAP YAZDINN... ORNEK DOSYAYI INDIRDIM VE TAM ISTEDIGIM GIBI OLMUS....

ALLAH RAZI OLSUN ELLERINE SAGLIK......

SAOLASINNN
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,428
Excel Vers. ve Dili
Ofis 365 Türkçe
eee Baktım ki Ankara'lısınız torpil geçeyim dedim :)
güle güle kullanınız.
 

senuyurken

Altın Üye
Katılım
20 Nisan 2008
Mesajlar
168
Excel Vers. ve Dili
Office 2021 TR
Altın Üyelik Bitiş Tarihi
25-06-2025
eee Baktım ki Ankara'lısınız torpil geçeyim dedim :)
güle güle kullanınız.
Necdet Kardes cok saol yardikmlarin icin...


karde bir sorum daha olacakk...

senin yapmis oldugun ornek dosyayi tekrar ekledim... Aacaba sayfa 1 deki tabloda tum kayitlari sayfa ikiye tekrar listeleyebilirmiyiz. Cift kayitlarin toplamini alarak. Yani sayfa 1 deki tum liste olacak ayni zamanda sayfa bir deki cift kayit sayfa 2 de tutarlari toplanmis olarak tek isim olarak cikacak....


Tesekkur ederim ..




selametle...
ANKARA...:)
 

Necdet

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

Kodlardaki fazlalıkları atınca istediğiniz olur.

Kod:
Sub AvansBul()
Application.ScreenUpdating = False
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s2.Range("A3:C65536").ClearContents
Dim i, sn, Var, SonSat As Integer
sn = 2
SonSat = s1.[A65536].End(3).Row
For i = 3 To SonSat
    Set Bul = s2.Columns(1).Find(s1.Cells(i, "A"))
    If Bul Is Nothing Then
        sn = sn + 1
        s2.Cells(sn, "A") = s1.Cells(i, "A")
        s2.Cells(sn, "B") = s1.Cells(i, "B")
        s2.Cells(sn, "C") = s1.Cells(i, "C")
    Else
        s2.Cells(Bul.Row, "C") = s2.Cells(Bul.Row, "C") + s1.Cells(i, "C")
    End If
Next i
s2.Columns("C:C").NumberFormat = "#,##0.00"
MsgBox "İşlem Tamamdır"
Application.ScreenUpdating = True
End Sub
 
Son düzenleme:

senuyurken

Altın Üye
Katılım
20 Nisan 2008
Mesajlar
168
Excel Vers. ve Dili
Office 2021 TR
Altın Üyelik Bitiş Tarihi
25-06-2025
Merhaba,

Kodlardaki fazlalıkları atınca istediğiniz olur.

Kod:
Sub AvansBul()
Application.ScreenUpdating = False
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s2.Range("A3:C65536").ClearContents
Dim i, sn, Var, SonSat As Integer
sn = 2
SonSat = s1.[A65536].End(3).Row
For i = 3 To SonSat
    Set Bul = s2.Columns(1).Find(s1.Cells(i, "A"))
    If Bul Is Nothing Then
        sn = sn + 1
        s2.Cells(sn, "A") = s1.Cells(i, "A")
        s2.Cells(sn, "B") = s1.Cells(i, "B")
        s2.Cells(sn, "C") = s1.Cells(i, "C")
    Else
        s2.Cells(Bul.Row, "C") = s2.Cells(Bul.Row, "C") + s1.Cells(i, "C")
    End If
Next i
s2.Columns("C:C").NumberFormat = "#,##0.00"
MsgBox "İşlem Tamamdır"
Application.ScreenUpdating = True
End Sub

necdet bey tesekkur ederim. Mumkunse diosyayi excel dosyasi ekleyebilirmisiniz. zipli dosyalari inderemiyorum... Tesekkur ederim...
 

Necdet

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

9. mesajdan dosyayı indirebilirsiniz.
 

Ö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,

Alternatif olarak Fonksiyonlarla hazırlanmış dosta ektedir.



.
 
Üst