• DİKKAT

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

Borç türü ve em.san.nu.göre borçalrını yazdırmak

  • Konbuyu başlatan Konbuyu başlatan unur
  • Başlangıç tarihi Başlangıç tarihi
U

unur

Altın Üye
Katılım
8 Aralık 2005
Mesajlar
854
Excel Vers. ve Dili
İş:Excel 2000 Türkçe
Ev:Excel xp Türkçe
Arkadaşlar ekli dosyada açıkladığım üzere em.san.numarasına ve borç türüne göre borçlarını belge üzerine yazdırmak istiyorum.
Yardımcı olursanız sevinirim.
 

Ekli dosyalar

sayın adsoft Teşekkürler.
Kesinti ismini değilde miktarını yazdırmak istiyorum.Eğer borcu yoksa boş yada sıfır yazmasını istiyorum.Yazdığınız formulde borç miktarı değilde borç adını yazıyor.Örn:Em.San nu 4444444 yazarsanız oyak mesken borcunun karşınına yani miktarı hanesine icra yazıyor.
 
unur' Alıntı:
sayın adsoft Teşekkürler.
Kesinti ismini değilde miktarını yazdırmak istiyorum.Eğer borcu yoksa boş yada sıfır yazmasını istiyorum.Yazdığınız formulde borç miktarı değilde borç adını yazıyor.Örn:Em.San nu 4444444 yazarsanız oyak mesken borcunun karşınına yani miktarı hanesine icra yazıyor.
Genişletmek için tıkla ...

şidmi bir bakarsan sana zahmet
 

Ekli dosyalar

adsoft emekleriniz için teşekkürler ama borç miktarı hanesine borç ismi geliyor yazdığınız formulle.Tekrar incelermisiniz?
Dosyada daha açıklayıcı bilgi verdim.Dosya ektedir.
 

Ekli dosyalar

unur' Alıntı:
Arkadaşlar ekli dosyada açıkladığım üzere em.san.numarasına ve borç türüne göre borçlarını belge üzerine yazdırmak istiyorum.
Yardımcı olursanız sevinirim.
Genişletmek için tıkla ...

Ay.Katılış sayfa ismini VERİ sayfası olarak değiştirin ve aşağıdaki kodu deneyin.




Kod: 
Sub deneme()
For r = 3 To Worksheets("Borçlar").Cells(Rows.Count, "A").End(3).Row
aranan1 = Sheets("Borçlar").Cells(r, 1).Value
aranan2 = Sheets("VERİ").Cells(9, "g").Value
If Sheets("Borçlar").Cells(r, 1).Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("Borçlar").Range("A3:A" & r), aranan1) = 1 Then
For j = r To Worksheets("Borçlar").Cells(Rows.Count, "B").End(3).Row
aranan4 = Sheets("Borçlar").Cells(j, 1).Value
aranan3 = Sheets("Borçlar").Cells(j, 4).Value
If aranan4 = aranan1 Then
If aranan2 = aranan1 Then
sat = 0
sat1 = 0
For n = 1 To 2
For i = 39 To 43
If LCase(Sheets("VERİ").Cells(i, 2 + sat).Value) = LCase(aranan3) Then
Sheets("VERİ").Cells(i, 8 + sat1).Value = Sheets("Borçlar").Cells(j, "e").Value
Sheets("VERİ").Cells(i, 12 + sat).Value = Sheets("Borçlar").Cells(j, "g").Value
End If
Next i
sat = sat + 14
sat1 = sat1 + 13
Next n
End If
End If
Next j
End If
End If
Next r
MsgBox "işlem tamam"
End Sub

not:eğer kod eksik veya yanlış olduysa kırmızı ve mavi hücrelerin hepsine veri gelecek şekilde borçlar sayfasına verileri girin ve sizde manuel olarak kırmızı ve mavi hücrelere bu değerleri manuel olarak girin ve bu uygulamalar ile örnek dosyanızı ekleyin
 
Halid Hocam Çok teşekkürler.
Gördüğüm aksaklıkları dosyada yazdım.Yardımcı olursanız sevinirim.
 

Ekli dosyalar

unur' Alıntı:
Halid Hocam Çok teşekkürler.
Gördüğüm aksaklıkları dosyada yazdım.Yardımcı olursanız sevinirim.
Genişletmek için tıkla ...

Öncelikle mesajlarını ve açıklamalarını bu bölüme yaz herseferinde dosyanı indirmek zorunda kalmayım zira kota sorunu var

kod

Kod: 
Sub Düğme1_Tıklat()
Sheets("VERİ").Range("H39:N43").ClearContents
Sheets("VERİ").Range("U39:AB43").ClearContents
For r = 3 To Worksheets("Borçlar").Cells(Rows.Count, "A").End(3).Row
aranan1 = Sheets("Borçlar").Cells(r, 1).Value
aranan2 = Sheets("VERİ").Cells(9, "g").Value
If Sheets("Borçlar").Cells(r, 1).Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("Borçlar").Range("A3:A" & r), aranan1) = 1 Then
For j = r To Worksheets("Borçlar").Cells(Rows.Count, "B").End(3).Row
aranan4 = Sheets("Borçlar").Cells(j, 1).Value
aranan3 = Sheets("Borçlar").Cells(j, 4).Value
If aranan4 = aranan1 Then
If aranan2 = aranan1 Then
sat = 0
sat1 = 0
For n = 1 To 2
For i = 39 To 43
If Replace(LCase(Sheets("VERİ").Cells(i, 2 + sat).Value), "İ", "i") = Replace(LCase(aranan3), "İ", "i") Then
Sheets("VERİ").Cells(i, 8 + sat1).Value = Sheets("Borçlar").Cells(j, "e").Value
Sheets("VERİ").Cells(i, 12 + sat).Value = Sheets("Borçlar").Cells(j, "g").Value
End If
Next i
sat = sat + 14
sat1 = sat1 + 13
Next n
End If
End If
Next j
End If
End If
Next r
MsgBox "işlem tamam"
End Sub

sayfaya ait kod

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [g9]) Is Nothing Then Exit Sub
Düğme1_Tıklat
End Sub

veri sayfasındaki bitiş tarih hücreleri(hücreleri biçimlendir/tarih) olmalı

not :borçlar sayfasındaki D sutünundaki Tıp başlık bölümlerindeki verilerle veri sayfasındaki tür suıtünuna ait veriler aynı olmalı bu veriler borçlar sayfasında büyük ve küçük harf kullanılmış veri sayfasında hepsi büyük kullanılmış bunların hepsi ya büyük yada küçük yada yazım düzeni formatında olmalı şimdilik ben i harfini hallettim.
 
Halit hocam çok teşekkürler.Özür dilerim.Kota yönüyle hiç düşünmemiştim.
 
Halit Hocam Çok Özür diliyorum.Çok fazla yük oldum ama bir şey daha sorabilirmiyim.Teknik olarak
Aşağıdaki kodda G9 hücresindeki bilgiyi manuel olarak yazdığımızda proplem yok. Ancak G9 hücresindeki değer formülle (başka sayfadan bilgi aldığından) değiştiği zaman Düğme1_Tıklat kodu çalışmıyor ne yapmam lazım.
Teşekkürler.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [g9]) Is Nothing Then Exit Sub
Düğme1_Tıklat
End Sub
 
Sayın adsoft Teşekkürler; Formülleri biraz daha incelermisiniz? Aynı kişinin bir kaç tane borcuda olabilir.Orada bir proplem var. Hizmet borcu oyak ikrazla aynı rakamı alıyor.İncelerseniz sevinirim.
 

Ekli dosyalar

unur' Alıntı:
Halit Hocam Çok Özür diliyorum.Çok fazla yük oldum ama bir şey daha sorabilirmiyim.Teknik olarak
Aşağıdaki kodda G9 hücresindeki bilgiyi manuel olarak yazdığımızda proplem yok. Ancak G9 hücresindeki değer formülle (başka sayfadan bilgi aldığından) değiştiği zaman Düğme1_Tıklat kodu çalışmıyor ne yapmam lazım.
Teşekkürler.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [g9]) Is Nothing Then Exit Sub
Düğme1_Tıklat
End Sub
Genişletmek için tıkla ...

Hücredeki formülün değişmesiyle aşağıdaki kod çalışmaz kodun çalışması için hücreye imleçle bir değer yazıp enter tuşu tetiklemeli,

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [g9]) Is Nothing Then Exit Sub
Düğme1_Tıklat
End Sub

diğer taraftan formüllü hücrede kodu çalıştırmak için makro komut düğmesine bu (Düğme1_Tıklat) olay yordamına bağlayıp düğmeye tıklamak gerekiyor
 
unur' Alıntı:
Sayın adsoft Teşekkürler; Formülleri biraz daha incelermisiniz? Aynı kişinin bir kaç tane borcuda olabilir.Orada bir proplem var. Hizmet borcu oyak ikrazla aynı rakamı alıyor.İncelerseniz sevinirim.
Genişletmek için tıkla ...

Halit hocam Teşekkürler, Uyarılarınız doğrultusunda uygulamaya çalışacam. Sayın Adsof formülleri incelerseniz sevinirim.Teşekkürler.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst