• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Cari hesap karşılaştırma

T

takirti

Katılım
29 Ekim 2006
Mesajlar
295
Excel Vers. ve Dili
OFİS 2003 Türkçe
Ekte bulunan cari hesap eksterelerinde 1. kısımla 2. kısmı 3 kısımda toplamak istiyorum. ama cari hesaplar sıralı olmadığı için biraz zorluk çekiyorum. Bunu makro ile yapmak mümkünmü acaba. Makro ile müşteri kodu aynı olan 1. kısım ve 2 kısım bakiyelerini 3 .kısma cari hesap kodu cari hesap adı ile birlikte atmasını istiyorum..
 

Ekli dosyalar

Dosyanız ektedir.:cool:
Kod: 
Sub mukererer_59_ado()
Dim conn As ADODB.Connection, rs As ADODB.Recordset
Dim sat1 As Long, sat2 As Long
Application.ScreenUpdating = False
Sheets("Sayfa3").Select
Range("A3:C65536").ClearContents
sat1 = Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
If sat1 > 2 Then
    Sheets("Sayfa1").Range("A3:B" & sat1 & ",G3:G" & sat1).Copy
    Range("A3").PasteSpecial (xlPasteValues)
End If
sat1 = Sheets("Sayfa2").Cells(65536, "A").End(xlUp).Row
If sat1 > 2 Then
    sat2 = Cells(65536, "A").End(xlUp).Row + 1
    Sheets("Sayfa2").Range("A3:B" & sat1 & ",G3:G" & sat1).Copy
    Range("A" & sat2).PasteSpecial (xlPasteValues)
End If
Application.CutCopyMode = False
Range("A2").Select
sat2 = Cells(65536, "A").End(xlUp).Row
If sat2 > 2 Then
    Set conn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    conn.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=no"""
    rs.Open "select first(F1),first(F2),sum(F3) from [Sayfa3$A3:C65536] group by F1;", conn, adOpenKeyset, adLockReadOnly
    Range("A3:C65536").ClearContents
    Range("A3").CopyFromRecordset rs
    rs.Close: conn.Close
    Set rs = Nothing
    Set conn = Nothing
    Application.ScreenUpdating = True
    MsgBox "İşlem tammalandı" & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End If
Application.ScreenUpdating = True
End Sub
 

Ekli dosyalar

hocam belki istediğimi yanlış anlattım. ekli dosyada sayfa1de ve sayfa2 veriler var. sayfa1 ve sayfa2 deli cari hesaplar kodlarına göre sayfa3 aktarılacak c sutununa sayfa1deki bakiye d sutununa sayfa2 deki bakiyesi gelsin istiyorum.
 
tabiki sayfa1 cari hesabın bakiyesi olup sayfa2de olmayabilir. aynı durum sayfa2de cari hesabın bakiyesi varken sayfa1 de olmayabilir. sonuçta sayfa1 ve sayfa2 deki cariler mükerrer olmayacak şekilde sayfa3 listelenecek ve sayfa1 ve/veya sayfa2 deki bakiyeler yanlarına birer sutun aracılığıyla aktarılacak.
 
takirti' Alıntı:
Ekte bulunan cari hesap eksterelerinde 1. kısımla 2. kısmı 3 kısımda toplamak istiyorum. ama cari hesaplar sıralı olmadığı için biraz zorluk çekiyorum. Bunu makro ile yapmak mümkünmü acaba. Makro ile müşteri kodu aynı olan 1. kısım ve 2 kısım bakiyelerini 3 .kısma cari hesap kodu cari hesap adı ile birlikte atmasını istiyorum...
Genişletmek için tıkla ...

takirti' Alıntı:
hocam belki istediğimi yanlış anlattım. ekli dosyada sayfa1de ve sayfa2 veriler var. sayfa1 ve sayfa2 deli cari hesaplar kodlarına göre sayfa3 aktarılacak c sutununa sayfa1deki bakiye d sutununa sayfa2 deki bakiyesi gelsin istiyorum.
Genişletmek için tıkla ...
İlk sorunuzda toplanacak demişsiniz mükerrerler.
2nci açıklamnaızda ise böyle bir ibare yok.
Mükererler toplanmayacakmı?
Nasıl olacak ben anlamadım.
Her 2 sayafadada ne kadar mükerrer varsa onlar toplanıp teke indiriliyor benim yaptığımda.Burada benim yaptığımda neresi yanlış onu söyleyiniz.:cool:
 
Evren Gizlen' Alıntı:
İlk sorunuzda toplanacak demişsiniz mükerrerler.
2nci açıklamnaızda ise böyle bir ibare yok.
Mükererler toplanmayacakmı?
Nasıl olacak ben anlamadım.
Her 2 sayafadada ne kadar mükerrer varsa onlar toplanıp teke indiriliyor benim yaptığımda.Burada benim yaptığımda neresi yanlış onu söyleyiniz.:cool:
Genişletmek için tıkla ...

hocam yanlış aktarmış olabilir.
istediğim sey 2 sayfadaki bakiyeleri 3. sayfaya aktarılması. cari hesap kodu ünvan 1. sayfa bakiyesi 2 sayfa bakiyesi şeklinde. sonrada sayfa3 de ayrı ayrı gelen bakiyeler e sutununda toplanacak. şu şekilde sayfa 1 2009 yılı bakiyesi var sayfa 2 de 2010 bakiyesi var. ben bunları sayfa3 ayrı ayrı getirip toplamını alacağım.

Hocam siz direk toplamlarını aldırmışınız. onun önüne bakiyelerde gelirse çok güzel olacak
 
takirti' Alıntı:
hocam yanlış aktarmış olabilir.
istediğim sey 2 sayfadaki bakiyeleri 3. sayfaya aktarılması. cari hesap kodu ünvan 1. sayfa bakiyesi 2 sayfa bakiyesi şeklinde.
Genişletmek için tıkla ...
Mükerrelik kontrolu olmayacakmı?
Ben yine anlamadım.
Yani soruyu yapabilmek için,anlayabilmek için 50 takla atıyoruz.
Anlamıyorum niye böyle oluyor.:cool:
 
mükerrerlik kontrolü olacak hocam. iki sayfada aynı olan cari hesap kodu ve ünvanın biri sayfa3 gelecek. sonrada bakiyeler.
 
takirti' Alıntı:
mükerrerlik kontrolü olacak hocam. iki sayfada aynı olan cari hesap kodu ve ünvanın biri sayfa3 gelecek. sonrada bakiyeler.
Genişletmek için tıkla ...

Ben zaten öyle yaptım.
Neyse biz anlaşamıyoruz.
Konudan çekiliyorum.
Başka bir arkadaştan yardım alınız.:cool:
 
örneği bir daha bakmanız müm künmü?

Hocam örneği yeniden bakarmıısnız. Ben etopla ile formüle ettim. Bunun makrosunu rica ediyorum.
Anlatamadığımızdan dolayı kusura bakma
 

Ekli dosyalar

takirti' Alıntı:
Hocam son kez bi bakın lütfen
Genişletmek için tıkla ...
Tamam halledicem.
Az bir işim var
1 sat sonra gelcem.
Şunu baştan yollasaydınız ne olurdu sanki?
Şimdi önce yaptığım emekler ne olacak.Boşa gitçek diilmi?
Bizede yazık günah değilmi.
Siz bir örnek dosya yapmaya üzşeniyorsunuz ama bizden yılamamamızı her defasında yardımda bulunmamızı isteyebiliyorsunuz.
Biz ne yapalım.Biz üşenmiyoruz ama.
Lütfen siz soru soranlarda üşenmesin.Biz yapanlar yardımcı olsunlar .Boşun auğraştırmasınlar.Biz sizin ne yaptığınız bilemeyiz.Siz biliyorsunzuudr ama biz konun dışındayız.İBilemeyiz.İyi örneklerle anlatırasanız dosya yolarsanız hemencecik çöazeriz.
Kod yazmak sorun değil.Konuyu anlamak sorun.Yoksa kodu 2 dakkada yazarım.
Yanlış anlamayın sitemim size değil.
Herkes böyle yapıyor.
Nasıl olsa uğraşıyorlar diyorlar.
Yaparlar diyorlar.
Uğraşıp uğraşıp sonunda yaparlar demeyin.
Bu dediklerim soru soran arkadaşlar içindir.
Çoğunlukta sorunuza hızlı ve doğru almak sizin elinizdedir.
Sorunuzla ilgilenilmeside aynen öyledir.
Sorunuz yapılmıyorsa veya ilgileniyormasa bunu başka yerde aramayın lütfen.
Ya imkansız bir şey sormuşsunuzdur yada sorunuz anlaşılmamıştır.
Görüşürüz.:cool:
 
Teşekkürler hocam.
aslında bu örnek bende vardı. malesef bilgisayarım göçtü. ve 5 yıllık tüm birikimlerimde onunla beraber gitti.
bundan sONRA DAHA DİKKATLİ olmaya çalışırım
saolun
 
takirti' Alıntı:
Teşekkürler hocam.
aslında bu örnek bende vardı. malesef bilgisayarım göçtü. ve 5 yıllık tüm birikimlerimde onunla beraber gitti.
bundan sONRA DAHA DİKKATLİ olmaya çalışırım
saolun
Genişletmek için tıkla ...
Bir yedekleme aygıtına düzenli aralıklarla yedekleme yaparsanız bu gibi istenmeyen durumlarla karşılaşmanız.
Mesela benim flash belleğim var onu devaml ıgüncelliyorum.
4 gb doldu.
Şidi 8 gb yeni bir tane alcam
orada yedklerimi tutçam.
:cool:
 
malesef şirket bilgisayarı. artık önlemler alındı. otomatik yedekleme oluşturuldu. olan bize oldu
 
Dosyanız ektedir.:cool:
Kod: 
Option Base 1
Sub mukerrlik_59()
Dim sat As Long, i As Long, myarr(), z As Object
Dim j As Byte, n As Long, list()
Sheets("Sayfa3").Select
Range("A4:E65536").ClearContents
Application.ScreenUpdating = False
ReDim myarr(1 To 5, 1 To 65536 * 2)
Set z = CreateObject("Scripting.Dictionary")
For j = 1 To 2
    sat = Sheets(j).Cells(65536, "A").End(xlUp).Row
    If sat > 2 Then
        list = Sheets(j).Range("A3:G" & sat).Value
        For i = 1 To UBound(list)
            If Not z.exists(list(i, 1)) Then
                n = n + 1
                z.Add list(i, 1), n
                myarr(1, n) = list(i, 1)
                myarr(2, n) = list(i, 2)
            End If
            myarr(j + 2, z.Item(list(i, 1))) = myarr(j + 2, z.Item(list(i, 1))) + list(i, 7)
            myarr(5, z.Item(list(i, 1))) = myarr(5, z.Item(list(i, 1))) + list(i, 7)
        Next i
        Erase list
    End If
Next j
Set z = Nothing
If n > 0 Then
    ReDim Preserve myarr(1 To 5, 1 To n)
    Range("A4").Resize(n, 5) = Application.Transpose(myarr)
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End If
Erase myarr
Application.ScreenUpdating = True
End Sub
 

Ekli dosyalar

saol hocam. işyerinde bir deneyeyim. bütün ihtimal olacaktır. saolun
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst