Makro ile biçimlendirme sorunu

[POLARIS]

İyi akşamlar,
bilanço sayfasında makro ile biçimlendirme yaptım.
Hepsi çalışıyor ancak başka bir sorunum oluştu.Yardımcı olabilirmisiniz.

Teşekkür eder iyi çalışmalar dilerim.

 

[Korhan Ayhan]

Merhaba,

Ben yapmak istediğiniz işlemi anlayamadım...

 

[POLARIS]

Korhan hocam merhaba,

Eki tekrar düzenledim.
C sütunu verilerin geliş biçimi.

B sütununda ise ( - ) karakterlerinin olmaması gerekiyor.
Bunun yerine ( 0 ) olmasını istiyorum.Burası tamam.

Ancak Örneğin satışların maliyeti ( - ) verisinin önündeki - (eksi)
karekterini de ( 0 ) yapıyor.Yada sayı pozitife dönüyor.(1.401.381)
Burayı değiştirmemesi gerekiyor. -1.401.381 olarak kalması lazım.


İlgileriniz için teşekkür ederim.
Esenkalınız...

 

[POLARIS]

Korhan hocam iyi akşamlar,

Eki tekrar düzenledim. Musait olduğunuz zaman bakar mısınız?
İyi çalışmalar dilerim.

 

[Korhan Ayhan]

Merhaba,

Dosyanızınn ham halini, verilerin hemen yanındaki sütunlara olması gereken değerleri yazıp foruma eklermisiniz.

 

[POLARIS]

Korhan bey iyi akşamlar,
Dosyanın ham hali ektedir.

Teşekkür eder iyi çalışmalar dilerim.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Kod örnek dosyanıza göre ilk sefer çalıştırdığınızda doğru sonuç verir. İkinci kez çalıştırırsanız bazı hücrelerdeki verileriniz bozulabilir.

Sub BİÇİMLENDİR()
    With Range("C4:C" & Cells(Rows.Count, 1).End(3).Row)
        .Replace What:="-", Replacement:=0, LookAt:=xlWhole
        .Replace What:=",", Replacement:="", LookAt:=xlPart
        .Replace What:=".", Replacement:=",", LookAt:=xlPart
        .NumberFormat = "#,##0"
    End With
End Sub

 

[POLARIS]

Korhan hocam iyi akşamlar,

Çok teşekkür ederim.Tam istediğim gibi oldu.
Çok oluyorsun demez iseniz, biçimlendirilmiş sütunu ŞİRKET BİLANÇOLARI adlı sayfaya ilgili sütun başlığı altına kopyalayıp kaydedebilirmiyiz.

İyi çalışmalar dilerim.
Esenkalınız...

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Sub AKTAR()
    Dim BUL As Range
    
    Set BUL = Sheets("ŞİRKETBİLANÇOLARI").Range("D1:BF1").Find(Range("B1"))
    If Not BUL Is Nothing Then
        Range("B3:B102").Copy
        Sheets("ŞİRKETBİLANÇOLARI").Cells(3, BUL.Column).PasteSpecial xlValues
        Application.CutCopyMode = False
    End If
    MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
End Sub

 

[POLARIS]

İyi akşamlar,

Korhan hocam harikasınız ,çok teşekkür ederim.
Esenkalınız...