Bs Formu Hazirlik Konusunda Yardim

[eraser]

Sabah yanlış başlık yüzünden açtığım konu taşınmıştı.
Konusunda uzman olan herkesten bu konuda yardımlarınızı rica ediyorum.
Daha önce Necdet bey bu konuda Ba formu ile ilgili yardımcı olmuştu.

Bs formu için bir çalışma yapmam gerekiyor acil yardımlarınız için ricalarımı sunuyorum.

Teşekkürler

 

[Ömer]

Merhaba,

Örnek dosyayı incelermisiniz..

 

[Necdet]

Merhaba,

Makro ile çözüm isterseniz dosyayı inceleyiniz.

 

[eraser]

Bs formu Hazırlık

Sayın Necdet hocam makro kodlarınızda size zahmet çalışma tablomda gözüken kişilerin VERGİ ve TC KİMLİK numaralarına göre derleme ve toplama yapabilirmisiniz.
size zahmet böyle bir düzenlenleme yaparsanız işlerimi daha iyi yetiştirebileceğim şimdiden teşekkürler.

Bu arada espiyonjl arkadaşımızada teşekkürlerimi sunuyorum.

 

[eraser]

Bs formu Hazırlık-yardım

Farkettimki satırlardaki cari isimli kişilerin ünvanları her zaman aynı olmamasından dolayı İsimler diğer sayfada farklı kişiler gibi görünmekte.
Netice itibari ile aynı isimlerin farklı yazılmaları sonucu ünvanın bir kişiye ait olmasına rağmen diğer sayfada farklı kişiler gibi gözükmesi.

cari ünvanlı aynı gibi gözüken isimler VERGİ NUMARALARI VE TC NUMARALARINA GÖRE ortak olduğundan diğer sayfaya derlenip toparlanacak.

Buna göre kodların düzeltilmesi halinde Sizin sayenizde ,sürekli vereceğim aylık formlarda çok kalıcı bir çalışma olmuş olacak.
Size zahmet Buna göre kodları yeniden düzenlerseniz çok sevinirim.
Teşekkürler.


Z.Kolaylı

 

[Necdet]

Merhaba,

Eğer doğru anladıysam kodlara aşağıdaki kırmızı renkli satırları eklemekle işin içinden kurtulmuş oluruz (sanırım )

Public Sub Derle()
Set s1 = Sheets("satış faturaları")
Set s2 = Sheets("bs formu")
s2.Cells.ClearContents
s2.Select
Application.ScreenUpdating = False
s1.Range("A1:J" & s1.[A65536].End(3).Row).Copy s2.[A1]
Range("A2:J" & s1.[A65536].End(3).Row).Sort Key1:=[B1]
For i = [A65536].End(3).Row To 3 Step -1
    If Cells(i, "B") = Cells(i - 1, "B") Then
[COLOR=red][B]        If Cells(i, "D") <> "" Then Cells(i - 1, "D") = Cells(i, "D")
        If Cells(i, "E") <> "" Then Cells(i - 1, "E") = Cells(i, "E")
[/B][/COLOR]        Cells(i - 1, "F") = Cells(i - 1, "F") + Cells(i, "F")
        Cells(i - 1, "J") = Cells(i - 1, "J") + Cells(i, "J")
        Rows(i).Delete
    End If
Next i
MsgBox "Düzenleme Tamamlanmıştır...."
End Sub

 

[eraser]

Sayın Necdet Hocam Merhabalar

Son vermiş olduğunuz kodları sabah işyerimde denedim.Sağolun

Fakat Vergi numaraları bir olan kişiler yine hala diğer sayfada Total duruma gelmiyor.

örnekli dosyamı inceleyip tekrar düzenleme yapabilirseniz çok memnun olurum.

saygılarımla.

Allah Kolaylık versin.

 

[Necdet]

Merhaba,

Vergi Numarası ve Kimlik No'ya göre kontrol etmeye çalıştım. Sizde kontrol eder misiniz?

Sub Derle()
Set s1 = Sheets("satış faturaları")
Set s2 = Sheets("bs formu")
s2.Cells.ClearContents
s2.Select
Application.ScreenUpdating = False
s1.Range("A1:J" & s1.[A65536].End(3).Row).Copy s2.[A1]
Range("A2:J" & s1.[A65536].End(3).Row).Sort Key1:=[D1], Key2:=[E2]
For i = [A65536].End(3).Row To 3 Step -1
    If (Cells(i, "D") = Cells(i - 1, "D") And Cells(i, "D") <> "") Or _
       (Cells(i, "E") = Cells(i - 1, "E") And Cells(i, "E") <> "") Then
            Cells(i - 1, "F") = Cells(i - 1, "F") + Cells(i, "F")
            Cells(i - 1, "J") = Cells(i - 1, "J") + Cells(i, "J")
            If Cells(i, "D") <> "" Then Cells(i - 1, "D") = Cells(i, "D")
            If Cells(i, "E") <> "" Then Cells(i - 1, "E") = Cells(i, "e")
            Rows(i).Delete
    End If
Next i
MsgBox "Düzenleme Tamamlanmıştır...."
End Sub

 

[eraser]

Sayın Necdet Hocam çok teşekkürler şuan sorun yok.
Çok güzel olmuş ellerinize sağlık.
Saygılar sunuyorum.