Cift Isimleri Bulma

senuyurken

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
 
N

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

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' Alıntı:
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
Genişletmek için tıkla ...


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
 
N

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

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' Alıntı:
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
Genişletmek için tıkla ...

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

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
 
N

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

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' Alıntı:
eee Baktım ki Ankara'lısınız torpil geçeyim dedim :)
güle güle kullanınız.
Genişletmek için tıkla ...
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...:)
 
N

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

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' Alıntı:
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
Genişletmek için tıkla ...

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

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

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



.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst