• DİKKAT

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

ÇÖZÜLDÜ: Fon İşlem Türleri makroyla nasıl düzeltilir?

A

assenucler

Altın Üye
Katılım
19 Ağustos 2004
Mesajlar
3,588
Excel Vers. ve Dili
Ofis 365 TR 64 Windows 11 Pro x64 TR
Değerli Dostlar,


Ekli dosyanın incelenmesinde de görüleceği gibi, BLF Hareketler sayfasına bir bankadaki para ile satın alın b tipi likit fon kağıdı ile satılan b tipi likit fon kağıtları, gün bazında kaydedilmektedir.. Bu sayfaya girilen işlemler "AKTAR" düğmesine tıklanınca, "ilgili ay Rapor" sayfalarına aktarılmaktadır.

Ancak aktarılan hareketler, rapor sayfalarının B sütununa kaydedildiğinde Fon İşlem Türü (FON ALIŞ, FON SATIŞ) yanlış olabilmektedir.

Rapor sayfalarında, gerekli düzeltmeleri yapabilmek için Tüm Rapor sayfalarında :

Satış TL (C sütunu) satırlarındaki TL. tutarı sıfırdan büyükse .....B sütunundaki satıra FON SATIŞ yazacak
Satış TL (C sütunu) satırlarındaki TL. tutarı sıfıra eşitse ............B sütunundaki satıra FON ALIŞ yazacak
Satış TL (C sütunu) satırları boş ise ................... B sütunundaki satıra hiç bir şey yazmaması için

geçerli olacak bir kod nasıl olmalıdır?

Yardımınız için önceden teşekkürler.
__________________
 

Ekli dosyalar

Son düzenleme:
assenucler' Alıntı:
Değerli Dostlar,


Ekli dosyanın incelenmesinde de görüleceği gibi, BLF Hareketler sayfasına bir bankadaki para ile satın alın b tipi likit fon kağıdı ile satılan b tipi likit fon kağıtları, gün bazında kaydedilmektedir.. Bu sayfaya girilen işlemler "AKTAR" düğmesine tıklanınca, "ilgili ay Rapor" sayfalarına aktarılmaktadır.

Ancak aktarılan hareketler, rapor sayfalarının B sütununa kaydedildiğinde Fon İşlem Türü (FON ALIŞ, FON SATIŞ) yanlış olabilmektedir.

Rapor sayfalarında, gerekli düzeltmeleri yapabilmek için Tüm Rapor sayfalarında :

Satış TL (C sütunu) satırlarındaki TL. tutarı sıfırdan büyükse .....B sütunundaki satıra FON SATIŞ yazacak
Satış TL (C sütunu) satırlarındaki TL. tutarı sıfıra eşitse ............B sütunundaki satıra FON ALIŞ yazacak
Satış TL (C sütunu) satırları boş ise ................... B sütunundaki satıra hiç bir şey yazmaması için

geçerli olacak bir kod nasıl olmalıdır?

Yardımınız için önceden teşekkürler.
__________________
Genişletmek için tıkla ...


Bu kodu bir dene

Kod: 
Sub AKTAR()


Application.Calculation = xlManual

Dim MM, MM1, MSTF, MSTF1, a

Dim ay(12)
ay(1) = "RAPOR_OCA"
ay(2) = "RAPOR_ŞUB"
ay(3) = "RAPOR_MAR"
ay(4) = "RAPOR_NİS"
ay(5) = "RAPOR_MAY"
ay(6) = "RAPOR_HAZ"
ay(7) = "RAPOR_TEM"
ay(8) = "RAPOR_AĞU"
ay(9) = "RAPOR_EYL"
ay(10) = "RAPOR_EKİ"
ay(11) = "RAPOR_KAS"
ay(12) = "RAPOR_ARA"

 

MM = 10
MMT = 10
[B4] = "=COUNTA(A8:A65536)"
[B4] = [B4]

For a = 2 To Sheets.Count
Sheets(a).Range("c3:o3").ClearContents
Sheets(a).Range("a10:r65536").ClearContents
Next a
[a4] = "Kalan Süre"
    Range("A4:B4").Select
    Selection.Font.Bold = True
    With Selection.Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
    Selection.Font.ColorIndex = 3
    Range("A4").Select
    

For MSTF = 8 To Sheets("BLF Hareketleri").Cells(65536, "B").End(xlUp).Row
MSTF1 = ay(Format(Sheets("BLF Hareketleri").Cells(MSTF, "A"), "mm"))

If Sheets("BLF Hareketleri").Cells(MSTF - 1, "a") = Sheets("BLF Hareketleri").Cells(MSTF, "a") Then
MM = Sheets(MSTF1).Range("A65536").End(3).Row
MMT = MMT - 1
Else
MM = Sheets(MSTF1).Range("A65536").End(3).Row + 1
End If

Sheets(MSTF1).Cells(MM, 1) = Sheets("BLF Hareketleri").Cells(MSTF, 1)
Sheets(MSTF1).Cells(MM, 2) = Sheets("BLF Hareketleri").Cells(MSTF, 2)
Sheets(MSTF1).Cells(MM, 16) = Sheets("BLF Hareketleri").Cells(MSTF, 16)
Sheets(MSTF1).Cells(MM, 17) = Sheets("BLF Hareketleri").Cells(MSTF, 17)

Sheets("RAPOR_TOPLAM").Cells(MMT, 1) = Sheets("BLF Hareketleri").Cells(MSTF, 1)
Sheets("RAPOR_TOPLAM").Cells(MMT, 2) = Sheets("BLF Hareketleri").Cells(MSTF, 2)
Sheets("RAPOR_TOPLAM").Cells(MMT, 16) = Sheets("BLF Hareketleri").Cells(MSTF, 16)
Sheets("RAPOR_TOPLAM").Cells(MMT, 17) = Sheets("BLF Hareketleri").Cells(MSTF, 17)

For MM1 = 3 To 15


Sheets(MSTF1).Cells(MM, MM1) = Sheets(MSTF1).Cells(MM, MM1) + Sheets("BLF Hareketleri").Cells(MSTF, MM1)
Sheets("RAPOR_TOPLAM").Cells(MMT, MM1) = Sheets("RAPOR_TOPLAM").Cells(MMT, MM1) + Sheets("BLF Hareketleri").Cells(MSTF, MM1)

Sheets(MSTF1).Cells(3, MM1) = Sheets(MSTF1).Cells(3, MM1) + Sheets("BLF Hareketleri").Cells(MSTF, MM1)
Sheets("RAPOR_TOPLAM").Cells(3, MM1) = Sheets("RAPOR_TOPLAM").Cells(3, MM1) + Sheets("BLF Hareketleri").Cells(MSTF, MM1)

[COLOR="Red"]If MM1 = 3 Then
If Sheets(MSTF1).Cells(MM, MM1) > 0 Then
Sheets(MSTF1).Cells(MM, 2) = "FON SATIŞ"
ElseIf Sheets(MSTF1).Cells(MM, MM1) = 0 Then
Sheets(MSTF1).Cells(MM, 2) = "FON ALIŞ"
ElseIf Sheets(MSTF1).Cells(MM, MM1) = "" Then
Sheets(MSTF1).Cells(MM, 2) = ""
End If

End If[/COLOR]


Next MM1
MMT = MMT + 1
[B4] = [B4] - 1
Next MSTF

Application.Calculation = xlAutomatic
MsgBox "Veriler Aktarılmıştır.", vbExclamation, "Mustafa MUTLU 0 533 740 45 49"
[B4] = ""
[a4] = ""
    Range("A4:B4").Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Font.ColorIndex = 0
    Selection.Font.Bold = False
    Range("A4").Select
End Sub
 
Teşekkürler

Sayın halit3,


Üstadım gününüz aydınlık, neşeniz ve sağlığınız yerinde, kazancınız bol olsun. Bu dinlence gününüzde zaman ayırarak bir sorunumu çözdüğünüz için çok teşekkür ederim.

En içten sevgi ve saygılarımı sunarım.
 
assenucler' Alıntı:
Sayın halit3,


Üstadım gününüz aydınlık, neşeniz ve sağlığınız yerinde, kazancınız bol olsun. Bu dinlence gününüzde zaman ayırarak bir sorunumu çözdüğünüz için çok teşekkür ederim.

En içten sevgi ve saygılarımı sunarım.
Genişletmek için tıkla ...

kod çok uzun yazılmış ve tarihlerle ilgili yıl geçince koda müdahale etmek gerekiyordu şimdi bu durum ortadan kalktı ayrıca dosyanızda hesaplamalarla ilgili formüller makroyu yavaşlatıyordu onuda düzelttik.
 
Sayın halit3 ve Mustafa Mutlu üstadım,

Sizler önümüzü aydınlatan, bizlere yol gösteren ve ışığımız olan gönül dostlarısınız, Allah sizden binlerce kez razı olsun.



Sevgi ve saygılarımla.
 
assenucler' Alıntı:
Sayın halit3 ve Mustafa Mutlu üstadım,

Sizler önümüzü aydınlatan, bizlere yol gösteren ve ışığımız olan gönül dostlarısınız, Allah sizden binlerce kez razı olsun.



Sevgi ve saygılarımla.
Genişletmek için tıkla ...

birde bu kodu dene burada sıfır değerler veya hücrede hiç değer yoksa sıfır yerine boş değer vermesi yani BLF Hareketleri sayfasında hücre içeriği neyse aynısı gibi gösteriyor.

Kod: 
Sub AKTAR()


Application.Calculation = xlManual

Dim MM, MM1, MSTF, MSTF1, a
Dim tarih1, tarih2
Dim ay(12)
ay(1) = "RAPOR_OCA"
ay(2) = "RAPOR_ŞUB"
ay(3) = "RAPOR_MAR"
ay(4) = "RAPOR_NİS"
ay(5) = "RAPOR_MAY"
ay(6) = "RAPOR_HAZ"
ay(7) = "RAPOR_TEM"
ay(8) = "RAPOR_AĞU"
ay(9) = "RAPOR_EYL"
ay(10) = "RAPOR_EKİ"
ay(11) = "RAPOR_KAS"
ay(12) = "RAPOR_ARA"

 

MM = 10
MMT = 10
[B4] = "=COUNTA(A8:A65536)"
[B4] = [B4]

For a = 2 To Sheets.Count
Sheets(a).Range("c3:o3").ClearContents
Sheets(a).Range("a10:r65536").ClearContents
Next a
[a4] = "Kalan Süre"

Range("A4:B4").Font.Bold = True
Range("A4:B4").Interior.ColorIndex = 6
Range("A4:B4").Font.ColorIndex = 3

For MSTF = 8 To Sheets("BLF Hareketleri").Cells(65536, "B").End(xlUp).Row
MSTF1 = ay(Format(Sheets("BLF Hareketleri").Cells(MSTF, "A"), "mm"))

tarih1 = Sheets("BLF Hareketleri").Cells(MSTF, 1)

If tarih1 = tarih2 Then
MM = Worksheets(MSTF1).Cells(Rows.Count, "A").End(3).Row
Else
MM = Worksheets(MSTF1).Cells(Rows.Count, "A").End(3).Row + 1
End If

Sheets(MSTF1).Cells(MM, 1) = Sheets("BLF Hareketleri").Cells(MSTF, 1)
Sheets(MSTF1).Cells(MM, 2) = Sheets("BLF Hareketleri").Cells(MSTF, 2)
Sheets(MSTF1).Cells(MM, 16) = Sheets("BLF Hareketleri").Cells(MSTF, 16)
Sheets(MSTF1).Cells(MM, 17) = Sheets("BLF Hareketleri").Cells(MSTF, 17)

Sheets("RAPOR_TOPLAM").Cells(MMT, 1) = Sheets("BLF Hareketleri").Cells(MSTF, 1)
Sheets("RAPOR_TOPLAM").Cells(MMT, 2) = Sheets("BLF Hareketleri").Cells(MSTF, 2)
Sheets("RAPOR_TOPLAM").Cells(MMT, 16) = Sheets("BLF Hareketleri").Cells(MSTF, 16)
Sheets("RAPOR_TOPLAM").Cells(MMT, 17) = Sheets("BLF Hareketleri").Cells(MSTF, 17)

For MM1 = 3 To 15

If Sheets(MSTF1).Cells(MM, MM1) = "" Then
If Sheets("BLF Hareketleri").Cells(MSTF, MM1) = "" Then
Sheets(MSTF1).Cells(MM, MM1) = ""
Else
Sheets(MSTF1).Cells(MM, MM1) = Sheets("BLF Hareketleri").Cells(MSTF, MM1)
End If
Else
Sheets(MSTF1).Cells(MM, MM1) = Sheets(MSTF1).Cells(MM, MM1) + Sheets("BLF Hareketleri").Cells(MSTF, MM1)
End If

Sheets("RAPOR_TOPLAM").Cells(MMT, MM1) = Sheets("RAPOR_TOPLAM").Cells(MMT, MM1) + Sheets("BLF Hareketleri").Cells(MSTF, MM1)

Sheets(MSTF1).Cells(3, MM1) = Sheets(MSTF1).Cells(3, MM1) + Sheets("BLF Hareketleri").Cells(MSTF, MM1)
Sheets("RAPOR_TOPLAM").Cells(3, MM1) = Sheets("RAPOR_TOPLAM").Cells(3, MM1) + Sheets("BLF Hareketleri").Cells(MSTF, MM1)

If MM1 = 3 Then
If Sheets(MSTF1).Cells(MM, MM1) > 0 Then
Sheets(MSTF1).Cells(MM, 2) = "FON SATIŞ"
ElseIf Sheets(MSTF1).Cells(MM, MM1) = 0 Then
Sheets(MSTF1).Cells(MM, 2) = "FON ALIŞ"
ElseIf Sheets(MSTF1).Cells(MM, MM1) = "" Then
Sheets(MSTF1).Cells(MM, 2) = ""
End If

End If


Next MM1
tarih2 = tarih1
MMT = MMT + 1
[B4] = [B4] - 1
Next MSTF

Application.Calculation = xlAutomatic
MsgBox "Veriler Aktarılmıştır.", vbExclamation, "Mustafa MUTLU 0 533 740 45 49"
[B4] = ""
[a4] = ""
Range("A4:B4").Interior.ColorIndex = xlNone
Range("A4:B4").Font.ColorIndex = 0
Range("A4:B4").Font.Bold = False
 
End Sub
 
Allah'ım sizler gibi dostları başımızdan eksik etmesin. Sağ olun var olun.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst