Para birimi formatını hücreden alma...

[pNouma]

Kıymetli Hocalarım merhaba;

ekli dosyada Sayfa1 adlı sayfada "C2" hücresinde seçimli olarak para birimleri (EUR, USD, TRL) mevcut,
C2 hücresinde yer alan para birimini aşağıda yer alan belirlenen hücrelere para birimi biçimi olarak aktarmak mümkün müdür?

https://dosya.co/936bn9hw8t22/Kitap6.xlsx.html


yardımlarınız için şimdiden teşekkürler,
iyi Çalışmalar.

 

[Mdemir63]

Selam

Yüklediğiniz dosyayı indiremiyorum. Başka bir siteye yükleyip paylaşırsanız daha iyi olur

 

[pNouma]

Selam

Yüklediğiniz dosyayı indiremiyorum. Başka bir siteye yükleyip paylaşırsanız daha iyi olur

Farklı bir siteye yükledim Hocam

https://www.dosyaupload.com/140z/Kitap6.xlsx

 

[ÖmerFaruk]

Sayfanızın KOD sayfasına yapıştırabilrisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [C2]) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Dim simge As String
    Dim myRange As Range
    Set myRange = Range("C6:D99") ' Burayı değiştirebilirsiniz
    simge = Range("C2").Value
    Select Case simge
        Case "TRL"
            simge = ChrW(8378)
        Case "EUR"
            simge = ChrW(8364)
        Case "USD"
            simge = ChrW(36)
    End Select
    If simge <> "" Then
        myRange.NumberFormatLocal = "_-" & simge & "* #.##0,00_-;" & "_-" & simge & "* -#.##0,00_-;" & "_-" & simge & "* ""-""??_-;_@_-"
    End If
    Application.EnableEvents = True
End Sub

 

[nihatkr]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ParaKodu As String
Dim hücre As Range
Dim FormatStr As String

If Not Intersect(Target, Me.Range("J32")) Is Nothing Then
On Error GoTo Cikis
Application.EnableEvents = False

Select Case Trim(UCase(Me.Range("J32").Value))
Case "TL": ParaKodu = "TL"
Case "USD": ParaKodu = "USD"
Case "EURO", "EUR": ParaKodu = "EUR"
Case Else: ParaKodu = ""
End Select

' Format seçimi
If ParaKodu = "" Then
FormatStr = "General"
Else
FormatStr = "#,##0.00 """ & ParaKodu & """"
End If

' G35:G100 ve H35:H100 hücrelerini güncelle
For Each hücre In Me.Range("G34:G100,H34:H100")
If IsNumeric(hücre.Value) And Not IsEmpty(hücre.Value) Then
hücre.NumberFormat = FormatStr
End If
Next hücre

Cikis:
Application.EnableEvents = True
End If
End Sub

 

[pNouma]

Sayfanızın KOD sayfasına yapıştırabilrisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [C2]) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Dim simge As String
    Dim myRange As Range
    Set myRange = Range("C6:D99") ' Burayı değiştirebilirsiniz
    simge = Range("C2").Value
    Select Case simge
        Case "TRL"
            simge = ChrW(8378)
        Case "EUR"
            simge = ChrW(8364)
        Case "USD"
            simge = ChrW(36)
    End Select
    If simge <> "" Then
        myRange.NumberFormatLocal = "_-" & simge & "* #.##0,00_-;" & "_-" & simge & "* -#.##0,00_-;" & "_-" & simge & "* ""-""??_-;_@_-"
    End If
    Application.EnableEvents = True
End Sub

Hocam teşekkürler,

anladığım kadarıyla kod olmadan formül ile bunu yapmak mümkün değil;

iyi Çalışmalar dilerim.

 

[pNouma]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ParaKodu As String
Dim hücre As Range
Dim FormatStr As String

If Not Intersect(Target, Me.Range("J32")) Is Nothing Then
On Error GoTo Cikis
Application.EnableEvents = False

Select Case Trim(UCase(Me.Range("J32").Value))
Case "TL": ParaKodu = "TL"
Case "USD": ParaKodu = "USD"
Case "EURO", "EUR": ParaKodu = "EUR"
Case Else: ParaKodu = ""
End Select

' Format seçimi
If ParaKodu = "" Then
FormatStr = "General"
Else
FormatStr = "#,##0.00 """ & ParaKodu & """"
End If

' G35:G100 ve H35:H100 hücrelerini güncelle
For Each hücre In Me.Range("G34:G100,H34:H100")
If IsNumeric(hücre.Value) And Not IsEmpty(hücre.Value) Then
hücre.NumberFormat = FormatStr
End If
Next hücre

Cikis:
Application.EnableEvents = True
End If
End Sub

Çok teşekkürler,
iyi Çalışmalar dilerim.