Bilanço Çeviri

[altanson]

Arkadaşlar Merhaba,

Elimde çok fazla veriden oluşan bir bilançom var. Bu bilançoyu belirli bir kurdan başka bir para birimine çevirmek istiyorum.

Tabloda formül içermeyen sayısal verilerin tümünü bir sayı ile çarpmak/bölmek için nasıl bir kod yazmalıyız?

Örnek dosya ekte;

Teşekkürler.

 

[Zeki Gürsoy]

Aşağıdaki proseduru deneyin.

Sub Duzenle()
Dim r As Range
 
On Error Resume Next

For Each r In [c6:d74]
    r = Round(r / 1.32, 2)
Next
 
End Sub

 

[veyselemre]

Sub Bol()
    For Each huc In Range("C6:D" & [d65536].End(3).Row).SpecialCells(xlCellTypeConstants, 1)
        huc.Value = huc.Value / 1.32
    Next
End Sub

 

[06eed]

sub Çevir
For Each r In [c6:d74]
If IsNumeric(r) Then r.Value = Round(r / 1.32, 2)
Next
end sub

Bu şekilde yapıtığınızda hataları atlatmanıza gerek kalmaz.

 

[altanson]

sn. veyselemre, sn. anemos,

cevaplarınız için teşekkürler.

 

[Merhum İdris SERDAR]

Arkadaşlar Merhaba,

Elimde çok fazla veriden oluşan bir bilançom var. Bu bilançoyu belirli bir kurdan başka bir para birimine çevirmek istiyorum.

Tabloda formül içermeyen sayısal verilerin tümünü bir sayı ile çarpmak/bölmek için nasıl bir kod yazmalıyız?

Örnek dosya ekte;

Teşekkürler.

Dosyanız ekte.

.

 

[udentr2002]

ben formül içermeyen hücrelerde bölme işlemini yapsın şeklinde anladım ama bu yüzden sayın veyselemre hocamın kodlarından giderek aşağıdaki kodu öneririm

Sub Bol()
On Error Resume Next

For Each huc In Range("C2:c" & [c65536].End(3).Row).SpecialCells(xlCellTypeConstants, 1)
If huc.Value = Formula Then GoTo 10
10 huc.Offset(0, 1).Select
huc.Value = huc.Value / 1.32

Next

Böylelikle formül içeren hücrelerde çalışmayacaktır

 

[altanson]

Sn. yurttas ve cevap veren tüm arkadaşlara teşekkürler,

sn. yurttas ın hazırladığı dosya tam istediğim gibi olmuş fakat dediğim aralıktaki formül içeren hücreleri değiştirmemesi mümkün mü?

 

[Merhum İdris SERDAR]

Sn. yurttas ve cevap veren tüm arkadaşlara teşekkürler,

sn. yurttas ın hazırladığı dosya tam istediğim gibi olmuş fakat dediğim aralıktaki formül içeren hücreleri değiştirmemesi mümkün mü?

Yukarıdaki kodlardan yararlanarak, hazırladığım dosya ekte.

.

 

[altanson]

Sn. yurttas tekrar tekrar teşekkürler;

benim veri aralığım C7:S81 ile V7:AM81 hücreleri aralığında. kodu nasıl düzeltebilirim.

 

[altanson]

arkadaşlar kod aralığını C7:S81 ile V7:AM81 olarak nasıl değiştirebilirim?

sanırım bu bölümü değiştirmem gerekli ama nasıl yapacağımı bulamadım;

For Each huc In Range("C7:s" & [c65536].End(3).Row).SpecialCells(xlCellTypeConstants, 1)

 

[Merhum İdris SERDAR]

Private Sub ToggleButton1_Click()

Application.ScreenUpdating = False

If ToggleButton1.Value = True Then



For Each huc In Range("C7:S" & [S65536].End(3).Row).SpecialCells(xlCellTypeConstants, 1)
If huc.Value = Formula Then GoTo 10
10 huc.Offset(0, 1).Select
huc.Value = huc.Value / [c1]

Next

For Each huc In Range("V7:c" & [AM65536].End(3).Row).SpecialCells(xlCellTypeConstants, 1)
If huc.Value = Formula Then GoTo 20
20 huc.Offset(0, 1).Select
huc.Value = huc.Value / [c1]

Next

[a4] = "BİLANÇO (Bin $)"
Range("C4").Select
ToggleButton1.Caption = "YTL'ye Çevir"



Else


For Each huc In Range("C2:S" & [S65536].End(3).Row).SpecialCells(xlCellTypeConstants, 1)
If huc.Value = Formula Then GoTo 30
30 huc.Offset(0, 1).Select
huc.Value = huc.Value * [c1]

Next

For Each huc In Range("V7:c" & [AM65536].End(3).Row).SpecialCells(xlCellTypeConstants, 1)
If huc.Value = Formula Then GoTo 40
40 huc.Offset(0, 1).Select
huc.Value = huc.Value * [c1]

Next

[a4] = "BİLANÇO (Bin YTL)"
Range("C4").Select
ToggleButton1.Caption = "$'a Çevir"

End If

Application.ScreenUpdating = True

End Sub


şeklinde deneyin.

.

 

[altanson]

kodu aşağıdaki gibi değiştirerek kendi dosyama uyguladım ama koyu yazılan yerde hata veriyor...

Application.ScreenUpdating = False

If ToggleButton1.Value = True Then



For Each huc In Range("C7:T" & [T65536].End(3).Row).SpecialCells(xlCellTypeConstants, 1)
If huc.Value = Formula Then GoTo 10
10 huc.Offset(0, 1).Select
huc.Value = huc.Value / [a2]

Next

For Each huc In Range("V7:AM" & [AM65536].End(3).Row).SpecialCells(xlCellTypeConstants, 1)
If huc.Value = Formula Then GoTo 10
[B][U]10[/U][/B] huc.Offset(0, 1).Select
huc.Value = huc.Value / [a2]

Next

[B1] = "BİLANÇO (Bin $)"
Range("C4").Select
ToggleButton1.Caption = "Convert to YTL"



Else


For Each huc In Range("C7:T" & [T65536].End(3).Row).SpecialCells(xlCellTypeConstants, 1)
If huc.Value = Formula Then GoTo 20
20 huc.Offset(0, 1).Select
huc.Value = huc.Value * [a2]

Next

For Each huc In Range("V7:AM" & [AM65536].End(3).Row).SpecialCells(xlCellTypeConstants, 1)
If huc.Value = Formula Then GoTo 20
20 huc.Offset(0, 1).Select
huc.Value = huc.Value * [a2]

Next

[B1] = "BİLANÇO (Bin YTL)"
Range("C4").Select
ToggleButton1.Caption = "Convert to USD"

End If

 

[Merhum İdris SERDAR]

kodu aşağıdaki gibi değiştirerek kendi dosyama uyguladım ama koyu yazılan yerde hata veriyor...

Yukarıda düzelttim.

.

 

[altanson]

sn yurttas ve yardımcı olan tüm arkadaşlar, hepinize teşekkürler...