Note: The other languages of the website are Google-translated. Back to English

Sayıları Excel'de Hint rupilerindeki kelimelere dönüştürmek nasıl?

Bu makalede, bir sayı listesinin Excel'de Hint rupisi veya İngiliz doları cinsinden kelimelere nasıl dönüştürüleceğini tanıtacağım.

VBA kodu ile sayıları Hint rupilerindeki kelimelere dönüştürün

Harika bir özellik ile sayıları İngiliz doları cinsinden kelimelere dönüştürün


VBA kodu ile sayıları Hint rupilerindeki kelimelere dönüştürün

Aşağıdaki VBA kodu, sayıları rupi cinsinden kelimelere dönüştürmenize yardımcı olabilir, lütfen şu şekilde yapın:

1. Basılı tutun ALT + F11 tuşlarını açmak için Uygulamalar için Microsoft Visual Basic pencere.

2. tıklayın Ekle > modülve aşağıdaki kodu Modül Penceresine yapıştırın.

VBA kodu: Sayıları rupi cinsinden kelimelere dönüştürün

Public Function RupeeFormat(SNum As String)
'Updateby Extendoffice
Dim xDPInt As Integer
Dim xArrPlace As Variant
Dim xRStr_Paisas As String
Dim xNumStr As String
Dim xF As Integer
Dim xTemp As String
Dim xStrTemp As String
Dim xRStr As String
Dim xLp As Integer
xArrPlace = Array("", "", " Thousand ", " Lacs ", " Crores ", " Trillion ", "", "", "", "")
On Error Resume Next
If SNum = "" Then
  RupeeFormat = ""
  Exit Function
End If
xNumStr = Trim(str(SNum))
If xNumStr = "" Then
  RupeeFormat = ""
  Exit Function
End If

xRStr = ""
xLp = 0
If (xNumStr > 999999999.99) Then
    RupeeFormat = "Digit excced Maximum limit"
    Exit Function
End If
xDPInt = InStr(xNumStr, ".")
If xDPInt > 0 Then
    If (Len(xNumStr) - xDPInt) = 1 Then
       xRStr_Paisas = RupeeFormat_GetT(Left(Mid(xNumStr, xDPInt + 1) & "0", 2))
    ElseIf (Len(xNumStr) - xDPInt) > 1 Then
       xRStr_Paisas = RupeeFormat_GetT(Left(Mid(xNumStr, xDPInt + 1), 2))
    End If
        xNumStr = Trim(Left(xNumStr, xDPInt - 1))
    End If
    xF = 1
    Do While xNumStr <> ""
        If (xF >= 2) Then
            xTemp = Right(xNumStr, 2)
        Else
            If (Len(xNumStr) = 2) Then
                xTemp = Right(xNumStr, 2)
            ElseIf (Len(xNumStr) = 1) Then
                xTemp = Right(xNumStr, 1)
            Else
                xTemp = Right(xNumStr, 3)
            End If
        End If
        xStrTemp = ""
        If Val(xTemp) > 99 Then
            xStrTemp = RupeeFormat_GetH(Right(xTemp, 3), xLp)
            If Right(Trim(xStrTemp), 3) <> "Lac" Then
            xLp = xLp + 1
            End If
        ElseIf Val(xTemp) <= 99 And Val(xTemp) > 9 Then
            xStrTemp = RupeeFormat_GetT(Right(xTemp, 2))
        ElseIf Val(xTemp) < 10 Then
            xStrTemp = RupeeFormat_GetD(Right(xTemp, 2))
        End If
        If xStrTemp <> "" Then
            xRStr = xStrTemp & xArrPlace(xF) & xRStr
        End If
        If xF = 2 Then
            If Len(xNumStr) = 1 Then
                xNumStr = ""
            Else
                xNumStr = Left(xNumStr, Len(xNumStr) - 2)
            End If
       ElseIf xF = 3 Then
            If Len(xNumStr) >= 3 Then
                 xNumStr = Left(xNumStr, Len(xNumStr) - 2)
            Else
                xNumStr = ""
            End If
        ElseIf xF = 4 Then
          xNumStr = ""
    Else
        If Len(xNumStr) <= 2 Then
        xNumStr = ""
    Else
        xNumStr = Left(xNumStr, Len(xNumStr) - 3)
        End If
    End If
        xF = xF + 1
Loop
    If xRStr = "" Then
       xRStr = "No Rupees"
    Else
       xRStr = " Rupees " & xRStr
    End If
    If xRStr_Paisas <> "" Then
       xRStr_Paisas = " and " & xRStr_Paisas & " Paisas"
    End If
    RupeeFormat = xRStr & xRStr_Paisas & " Only"
    End Function
Function RupeeFormat_GetH(xStrH As String, xLp As Integer)
Dim xRStr As String
If Val(xStrH) < 1 Then
    RupeeFormat_GetH = ""
    Exit Function
Else
   xStrH = Right("000" & xStrH, 3)
   If Mid(xStrH, 1, 1) <> "0" Then
        If (xLp > 0) Then
         xRStr = RupeeFormat_GetD(Mid(xStrH, 1, 1)) & " Lac "
        Else
         xRStr = RupeeFormat_GetD(Mid(xStrH, 1, 1)) & " Hundred "
        End If
    End If
    If Mid(xStrH, 2, 1) <> "0" Then
        xRStr = xRStr & RupeeFormat_GetT(Mid(xStrH, 2))
    Else
        xRStr = xRStr & RupeeFormat_GetD(Mid(xStrH, 3))
    End If
End If
    RupeeFormat_GetH = xRStr
End Function
Function RupeeFormat_GetT(xTStr As String)
    Dim xTArr1 As Variant
    Dim xTArr2 As Variant
    Dim xRStr As String
    xTArr1 = Array("Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
    xTArr2 = Array("", "Twenty", "Thirty", "Forty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
    Result = ""
    If Val(Left(xTStr, 1)) = 1 Then
        xRStr = xTArr1(Val(Mid(xTStr, 2, 1)))
    Else
        If Val(Left(xTStr, 1)) > 0 Then
            xRStr = xTArr2(Val(Left(xTStr, 1)) - 1)
        End If
        xRStr = xRStr & RupeeFormat_GetD(Right(xTStr, 1))
    End If
      RupeeFormat_GetT = xRStr
End Function
Function RupeeFormat_GetD(xDStr As String)
Dim xArr_1() As Variant
    xArr_1 = Array(" One", " Two", " Three", " Four", " Five", " Six", " Seven", " Eight", " Nine", "")
    If Val(xDStr) > 0 Then
        RupeeFormat_GetD = xArr_1(Val(xDStr) - 1)
    Else
        RupeeFormat_GetD = ""
    End If
End Function 

3. Kodu girdikten sonra, kod penceresini kaydedip kapatın, çalışma sayfasına geri dönün ve şu formülü girin: = RupeeFormat (A2) boş bir hücreye yerleştirin ve ardından bu formülü diğer hücrelere uygulamak için doldurma tutamacını aşağı doğru sürükleyin, tüm sayılar rupi olarak yazılmıştır, ekran görüntüsüne bakın:


Harika bir özellik ile sayıları İngiliz doları cinsinden kelimelere dönüştürün

Sayıları İngiliz doları cinsinden kelimelere dönüştürmek istiyorsanız, Kutools for Excel'S Sayılardan Kelimelere özelliği, bu işi hızlı ve kolay bir şekilde çözmenize yardımcı olabilir.

İpuçları:Bunu uygulamak için Kelimelere Sayı özelliği, öncelikle indirmelisiniz Kutools for Excelve ardından özelliği hızlı ve kolay bir şekilde uygulayın.

Kurduktan sonra Kutools for Excellütfen şunu yapın:

1. Dönüştürmek istediğiniz sayıların listesini seçin ve ardından Kutools > içerik > Sayılardan Kelimelere, ekran görüntülerine bakın:

2. In Para Birimi Kelimelerine Sayılar iletişim kutusunu seçin İngilizce seçeneği Diller bölümünü ve ardından tıklayın Ok düğmesi, seçimdeki sayılar İngilizce para birimi kelimelerine dönüştürüldü, ekran görüntüsüne bakın:

Kutools for Excel'i indirmek için tıklayın ve Şimdi ücretsiz deneme!

 


  • Süper Formül Çubuğu (birden çok metin ve formül satırını kolayca düzenleyin); Okuma Düzeni (çok sayıda hücreyi kolayca okuyun ve düzenleyin); Filtrelenmiş Aralığa Yapıştır...
  • Hücreleri / Satırları / Sütunları Birleştirme ve Verilerin Saklanması; Bölünmüş Hücre İçeriği; Yinelenen Satırları ve Toplam / Ortalamayı Birleştirme... Yinelenen Hücreleri Önleyin; Aralıkları Karşılaştır...
  • Yinelenen veya Benzersiz'i seçin Satırlar; Boş Satırları Seçin (tüm hücreler boştur); Süper Bul ve Bulanık Bul Birçok Çalışma Kitabında; Rastgele Seçim ...
  • Tam kopya Formül referansını değiştirmeden Birden Çok Hücre; Otomatik Referans Oluştur Birden Çok Sayfaya; Madde İşaretleri Ekle, Onay Kutuları ve daha fazlası ...
  • Sık Kullanılan ve Hızlı Eklenen Formüller, Aralıklar, Grafikler ve Resimler; Hücreleri Şifrele şifre ile; Posta Listesi Oluşturun ve e-posta gönder ...
  • Metni Çıkar, Metin Ekle, Konuma Göre Kaldır, Alanı Kaldır; Sayfalama Alt Toplamları Oluşturma ve Yazdırma; Hücre İçeriği ve Yorumları Arasında Dönüştür...
  • Süper Filtre (filtre şemalarını kaydedin ve diğer sayfalara uygulayın); Gelişmiş Sıralama ay / hafta / gün, sıklık ve daha fazlasına göre; Özel Filtre kalın, italik ...
  • Çalışma Kitaplarını ve Çalışma Sayfalarını Birleştirin; Tabloları anahtar sütunlara göre birleştirin; Verileri Birden Çok Sayfaya Bölme; Toplu dönüştürme xls, xlsx ve PDF...
  • Pivot Tablo Gruplaması hafta numarası, haftanın günü ve daha fazlası ... Kilidi Açılmış, Kilitli Hücreleri Göster farklı renklerle; Formülü / Adı Olan Hücreleri Vurgulayın...
kte sekmesi 201905
  • Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
  • Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
  • Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!
ofis tabanı

 

Yorumları sıralama ölçütü
Yorumlar (21)
Henüz derecelendirme yok. İlk değerlendiren siz olun!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Referans hücrenin valfi olmadığında Excel çöküyor!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, Kullanıcı,
Yorumunuz için teşekkür ederiz, bu makaledeki kod güncellendi, lütfen tekrar deneyin, teşekkürler!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili Efendim,

İyi günler,

Yukarıdaki formülü test ettim, -100 -10,000 veya (100) (10,000) gibi kısa çizgi eksi değerlerinde çalışmıyor

Efendim, son 1 yıldır aşağıdaki kodu kullanıyorum ve bugün aynı hatayı keşfettim.

Eksi -10,000 veya (10,000) yazdığımda "Yalnızca Yüz On Bin" yazıyor
Pozitif 10,000 yazdığımda harika çalışıyor "Yalnızca On Bin"

Aşağıdaki örnek:

(10,000.99) Sadece Yüz On Bin & 99/100 Riyal
10,000.99 Sadece On Bin & 99/100 Riyal
(10,000,000.99) Sadece Yüz On Milyon & 99/100 Riyal
10,000,000.99 Sadece On Milyon & 99/100 Riyal
(10,000,000,000.99) Sadece Yüz On Milyar & 99/100 Riyal
10,000,000,000.99 Sadece On Milyar & 99/100 Riyal
(10,000,000,000,000.90) Sadece Yüz On Trilyon ve 90/100 Riyal
10,000,000,000,000.90 Sadece On Trilyon ve 90/100 Riyal

Formül = heceleme

VBA KODUM:

'Ana işlev
İşlev Yazım Bildirimi(ByVal MyNumber)
Dim Riyals, Halalas, Sıcaklık
Dim DecimalYer, Say
ReDim Place(9) As String
Yer(2) = " Bin "
Yer(3) = " Milyon "
Yer(4) = " Milyar "
Yer(5) = " Trilyon"
' Tutarın dize temsili.
MyNumber = Kırp(Str(MyNumber))
' Yok ise ondalık basamağın konumu 0.
DecimalPlace = InStr(MyNumber, ".")
Halalas'ı dönüştürün ve MyNumber'ı Riyal miktarına ayarlayın.
DecimalPlace > 0 ise
Halalas = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Sol(MyNumber, DecimalPlace - 1))
Eğer son
Sayı = 1
MyNumber iken Yap <> ""
Sıcaklık = GetHundreds(Right(MyNumber, 3))
Eğer Sıcaklık <> "" ise Riyals = Temp & Place(Count) & Riyals
Len(MyNumber) > 3 ise
MyNumber = Sol(MyNumber, Len(MyNumber) - 3)
başka
Numaram = ""
Eğer son
Sayı = sayı + 1
döngü
Kasa Riyallerini Seçin
Durum ""
Riyal = "Riyal Yok"
Durum "Bir"
Riyal = "Yalnızca Bir Riyal"
Else Kılıf
Riyal = "Yalnızca" & Riyal
Riyal = Riyal & ""
Select End
Case Halalas'ı seçin
Durum ""
Halalas = " & 00/00 Riyal"
Durum "Bir"
Halalas = " & 01/100 Riyal"
Durum "İki"
Halalas = " & 02/100 Riyal"
Dava "Üç"
Halalas = " & 03/100 Riyal"
Dava "Dört"
Halalas = " & 04/100 Riyal"
Dava "Beş"
Halalas = " & 05/100 Riyal"
Dava "Altı"
Halalas = " & 06/100 Riyal"
Dava "Yedi"
Halalas = " & 07/100 Riyal"
Dava "Sekiz"
Halalas = " & 08/100 Riyal"
"Dokuz" vakası
Halalas = " & 09/100 Riyal"
Dava "On"
Halalas = " & 10/100 Riyal"
Dava "Onbir"
Halalas = " & 11/100 Riyal"
Dava "On İki"
Halalas = " & 12/100 Riyal"
Vaka "Onüç"
Halalas = " & 13/100 Riyal"
Dava "On Dört"
Halalas = " & 14/100 Riyal"
Dava "Onbeş"
Halalas = " & 15/100 Riyal"
Dava "Onaltı"
Halalas = " & 16/100 Riyal"
Dava "Onyedi"
Halalas = " & 17/100 Riyal"
"On sekiz" vakası
Halalas = " & 18/100 Riyal"
"Ondokuz" vakası
Halalas = " & 19/100 Riyal"
"Yirmi" vakası
Halalas = " & 20/100 Riyal"
Dava "Yirmi Bir"
Halalas = " & 21/100 Riyal"
Dava "Yirmi İki"
Halalas = " & 22/100 Riyal"
Dava "Yirmi Üç"
Halalas = " & 23/100 Riyal"
Dava "Yirmi Dört"
Halalas = " & 24/100 Riyal"
Dava "Yirmi Beş"
Halalas = " & 25/100 Riyal"
Dava "Yirmi Altı"
Halalas = " & 26/100 Riyal"
Dava "Yirmi Yedi"
Halalas = " & 27/100 Riyal"
Dava "Yirmi Sekiz"
Halalas = " & 28/100 Riyal"
Dava "Yirmi Dokuz"
Halalas = " & 29/100 Riyal"
"Otuz" vakası
Halalas = " & 30/100 Riyal"
Dava "Otuz Bir"
Halalas = " & 31/100 Riyal"
Dava "Otuz İki"
Halalas = " & 32/100 Riyal"
Dava "Otuz Üç"
Halalas = " & 33/100 Riyal"
"Otuz Dört" Davası
Halalas = " & 34/100 Riyal"
"Otuz Beş" Davası
Halalas = " & 35/100 Riyal"
Dava "Otuz Altı"
Halalas = " & 36/100 Riyal"
Dava "Otuz Yedi"
Halalas = " & 37/100 Riyal"
Dava "Otuz Sekiz"
Halalas = " & 38/100 Riyal"
Dava "Otuz Dokuz"
Halalas = " & 39/100 Riyal"
"Kırk" vakası
Halalas = " & 40/100 Riyal"
Dava "Kırk Bir"
Halalas = " & 41/100 Riyal"
Dava "Kırk İki"
Halalas = " & 42/100 Riyal"
Dava "Kırk Üç"
Halalas = " & 43/100 Riyal"
"Kırk Dört" Davası
Halalas = " & 44/100 Riyal"
"Kırk Beş" Davası
Halalas = " & 45/100 Riyal"
Dava "Kırk Altı"
Halalas = " & 46/100 Riyal"
Dava "Kırk Yedi"
Halalas = " & 47/100 Riyal"
Dava "Kırk Sekiz"
Halalas = " & 48/100 Riyal"
"Kırk Dokuz" vakası
Halalas = " & 49/100 Riyal"
"Elli" vakası
Halalas = " & 50/100 Riyal"
"Elli Bir" vakası
Halalas = " & 51/100 Riyal"
"Elli İki" Davası
Halalas = " & 52/100 Riyal"
Dava "Elli Üç"
Halalas = " & 53/100 Riyal"
Dava "Elli Dört"
Halalas = " & 54/100 Riyal"
"Elli Beş" Davası
Halalas = " & 55/100 Riyal"
Dava "Elli Altı"
Halalas = " & 56/100 Riyal"
"Elli Yedi" vakası
Halalas = " & 57/100 Riyal"
"Elli Sekiz" vakası
Halalas = " & 58/100 Riyal"
"Elli Dokuz" vakası
Halalas = " & 59/100 Riyal"
"Altmış" vakası
Halalas = " & 60/100 Riyal"
Dava "Altmış Bir"
Halalas = " & 61/100 Riyal"
Dava "Altmış İki"
Halalas = " & 62/100 Riyal"
Dava "Altmış Üç"
Halalas = " & 63/100 Riyal"
Dava "Altmış Dört"
Halalas = " & 64/100 Riyal"
Dava "Altmış Beş"
Halalas = " & 65/100 Riyal"
Dava "Altmış Altı"
Halalas = " & 66/100 Riyal"
Dava "Altmış Yedi"
Halalas = " & 67/100 Riyal"
Dava "Altmış Sekiz"
Halalas = " & 68/100 Riyal"
Dava "Altmış Dokuz"
Halalas = " & 69/100 Riyal"
"Yetmiş" vakası
Halalas = " & 70/100 Riyal"
"Yetmiş Bir" vakası
Halalas = " & 71/100 Riyal"
Dava "Yetmiş İki"
Halalas = " & 72/100 Riyal"
Dava "Yetmiş Üç"
Halalas = " & 73/100 Riyal"
Dava "Yetmiş Dört"
Halalas = " & 74/100 Riyal"
"Yetmiş Beş" Davası
Halalas = " & 75/100 Riyal"
Dava "Yetmiş Altı"
Halalas = " & 76/100 Riyal"
Dava "Yetmiş Yedi"
Halalas = " & 77/100 Riyal"
Dava "Yetmiş Sekiz"
Halalas = " & 78/100 Riyal"
"Yetmiş Dokuz" vakası
Halalas = " & 79/100 Riyal"
"Seksen" vakası
Halalas = " & 80/100 Riyal"
Dava "Seksen Bir"
Halalas = " & 81/100 Riyal"
Dava "Seksen İki"
Halalas = " & 82/100 Riyal"
Dava "Seksen Üç"
Halalas = " & 83/100 Riyal"
Dava "Seksen Dört"
Halalas = " & 84/100 Riyal"
Dava "Seksen Beş"
Halalas = " & 85/100 Riyal"
Dava "Seksen Altı"
Halalas = " & 86/100 Riyal"
Dava "Seksen Yedi"
Halalas = " & 87/100 Riyal"
Dava "Seksen Sekiz"
Halalas = " & 88/100 Riyal"
Dava "Seksen Dokuz"
Halalas = " & 89/100 Riyal"
"Doksan" vakası
Halalas = " & 90/100 Riyal"
Dava "Doksan Bir"
Halalas = " & 91/100 Riyal"
Dava "Doksan İki"
Halalas = " & 92/100 Riyal"
Dava "Doksan Üç"
Halalas = " & 93/100 Riyal"
Dava "Doksan Dört"
Halalas = " & 94/100 Riyal"
Dava "Doksan Beş"
Halalas = " & 95/100 Riyal"
Dava "Doksan Altı"
Halalas = " & 96/100 Riyal"
Dava "Doksan Yedi"
Halalas = " & 97/100 Riyal"
Dava "Doksan Sekiz"
Halalas = " & 98/100 Riyal"
Dava "Doksan Dokuz"
Halalas = " & 99/100 Riyal"


Else Kılıf
Halalas = " & " & Halalas & " Halalas"
Select End
SpellBilling = Riyaller ve Halalalar
son İşlevi


' 100-999 arasındaki bir sayıyı metne dönüştürür
İşlev GetHundreds(ByVal MyNumber)
Sonucu Dize Olarak Karart
Val(MyNumber) = 0 ise Fonksiyondan Çık
MyNumber = Sağ ("000" ve MyNumber, 3)
' Yüzlerce basamağı çevir.
Eğer Orta(MyNumber, 1, 1) <> "0" Sonra
Sonuç = GetDigit(Mid(MyNumber, 1, 1)) & " Yüz "
Eğer son
' Onlarca ve birler basamağını dönüştürün.
Eğer Orta(MyNumber, 2, 1) <> "0" Sonra
Sonuç = Sonuç ve GetTens(Mid(MyNumber, 2))
başka
Sonuç = Sonuç ve GetDigit(Mid(MyNumber, 3))
Eğer son
GetHundreds = Sonuç
son İşlevi

' 10'dan 99'a kadar bir sayıyı metne dönüştürür.
İşlev GetTens(TensText)
Sonucu Dize Olarak Karart
Result = "" ' Geçici işlev değerini sıfırlayın.
Eğer Val(Left(TensText, 1)) = 1 O halde ' 10-19 arası bir değer ise...
Vaka Seç Val(TensText)
Durum 10: Sonuç = "On"
Durum 11: Sonuç = "Onbir"
Vaka 12: Sonuç = "On iki"
Vaka 13: Sonuç = "On üç"
Vaka 14: Sonuç = "Ondört"
Vaka 15: Sonuç = "Onbeş"
Vaka 16: Sonuç = "Onaltı"
Vaka 17: Sonuç = "Onyedi"
Vaka 18: Sonuç = "Onsekiz"
Vaka 19: Sonuç = "Ondokuz"
Else Kılıf
Select End
Else ' 20-99 arası bir değer ise...
Vaka Seç Val(Sol(TensText, 1))
Durum 2: Sonuç = "Yirmi"
Durum 3: Sonuç = "Otuz"
Durum 4: Sonuç = "Kırk"
Durum 5: Sonuç = "Elli"
Durum 6: Sonuç = "Altmış"
Durum 7: Sonuç = "Yetmiş"
Durum 8: Sonuç = "Seksen"
Durum 9: Sonuç = "Doksan"
Else Kılıf
Select End
Sonuç = Sonuç ve GetDigit _
(Right(TensText, 1)) ' Birlerin yerini al.
Eğer son
GetTens = Sonuç
son İşlevi

' 1'dan 9'a kadar bir sayıyı metne dönüştürür.
İşlev GetDigit(Rakam)
Vaka Seç Val(Rakam)
Durum 1: GetDigit = "Bir"
Durum 2: GetDigit = "İki"
Durum 3: GetDigit = "Üç"
Durum 4: GetDigit = "Dört"
Durum 5: GetDigit = "Beş"
Durum 6: GetDigit = "Altı"
Durum 7: GetDigit = "Yedi"
Durum 8: GetDigit = "Sekiz"
Durum 9: GetDigit = "Dokuz"
Başka Durum: GetDigit = ""
Select End
son İşlevi
Bu yorum sitedeki moderatör tarafından en aza indirildi
Söyleyecek bir şey yok! son derece süper
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili Efendim,

İyi günler,
VBA kodunuzu test ettim ama ne yazık ki -100 -10,000 / (100) (10,000) gibi negatif / eksi değerlerde iyi çalışmıyor.

Efendim, son 1 yıldır aşağıdaki kodu kullanıyorum ve bugün VBA kodunuzda da bulunan aynı hatayı keşfettim.

Eksi -10,000 yazdığımda "Yalnızca Yüz On Bin" yazıyor
Pozitif 10,000 yazdığımda, "Yalnızca On Bin" de iyi çalışıyor

Aşağıdaki örnek:

(10,000.99) Sadece Yüz On Bin & 99/100 Riyal
10,000.99 Sadece On Bin & 99/100 Riyal
(10,000,000.99) Sadece Yüz On Milyon & 99/100 Riyal
10,000,000.99 Sadece On Milyon & 99/100 Riyal
(10,000,000,000.99) Sadece Yüz On Milyar & 99/100 Riyal
10,000,000,000.99 Sadece On Milyar & 99/100 Riyal
(10,000,000,000,000.90) Sadece Yüz On Trilyon ve 90/100 Riyal
10,000,000,000,000.90 Sadece On Trilyon ve 90/100 Riyal

Formül = heceleme

VBA KODUM:

'Ana işlev
İşlev Yazım Bildirimi(ByVal MyNumber)
Dim Riyals, Halalas, Sıcaklık
Dim DecimalYer, Say
ReDim Place(9) As String
Yer(2) = " Bin "
Yer(3) = " Milyon "
Yer(4) = " Milyar "
Yer(5) = " Trilyon"
' Tutarın dize temsili.
MyNumber = Kırp(Str(MyNumber))
' Yok ise ondalık basamağın konumu 0.
DecimalPlace = InStr(MyNumber, ".")
Halalas'ı dönüştürün ve MyNumber'ı Riyal miktarına ayarlayın.
DecimalPlace > 0 ise
Halalas = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Sol(MyNumber, DecimalPlace - 1))
Eğer son
Sayı = 1
MyNumber iken Yap <> ""
Sıcaklık = GetHundreds(Right(MyNumber, 3))
Eğer Sıcaklık <> "" ise Riyals = Temp & Place(Count) & Riyals
Len(MyNumber) > 3 ise
MyNumber = Sol(MyNumber, Len(MyNumber) - 3)
başka
Numaram = ""
Eğer son
Sayı = sayı + 1
döngü
Kasa Riyallerini Seçin
Durum ""
Riyal = "Riyal Yok"
Durum "Bir"
Riyal = "Yalnızca Bir Riyal"
Else Kılıf
Riyal = "Yalnızca" & Riyal
Riyal = Riyal & ""
Select End
Case Halalas'ı seçin
Durum ""
Halalas = " & 00/00 Riyal"
Durum "Bir"
Halalas = " & 01/100 Riyal"
Durum "İki"
Halalas = " & 02/100 Riyal"
Dava "Üç"
Halalas = " & 03/100 Riyal"
Dava "Dört"
Halalas = " & 04/100 Riyal"
Dava "Beş"
Halalas = " & 05/100 Riyal"
Dava "Altı"
Halalas = " & 06/100 Riyal"
Dava "Yedi"
Halalas = " & 07/100 Riyal"
Dava "Sekiz"
Halalas = " & 08/100 Riyal"
"Dokuz" vakası
Halalas = " & 09/100 Riyal"
Dava "On"
Halalas = " & 10/100 Riyal"
Dava "Onbir"
Halalas = " & 11/100 Riyal"
Dava "On İki"
Halalas = " & 12/100 Riyal"
Vaka "Onüç"
Halalas = " & 13/100 Riyal"
Dava "On Dört"
Halalas = " & 14/100 Riyal"
Dava "Onbeş"
Halalas = " & 15/100 Riyal"
Dava "Onaltı"
Halalas = " & 16/100 Riyal"
Dava "Onyedi"
Halalas = " & 17/100 Riyal"
"On sekiz" vakası
Halalas = " & 18/100 Riyal"
"Ondokuz" vakası
Halalas = " & 19/100 Riyal"
"Yirmi" vakası
Halalas = " & 20/100 Riyal"
Dava "Yirmi Bir"
Halalas = " & 21/100 Riyal"
Dava "Yirmi İki"
Halalas = " & 22/100 Riyal"
Dava "Yirmi Üç"
Halalas = " & 23/100 Riyal"
Dava "Yirmi Dört"
Halalas = " & 24/100 Riyal"
Dava "Yirmi Beş"
Halalas = " & 25/100 Riyal"
Dava "Yirmi Altı"
Halalas = " & 26/100 Riyal"
Dava "Yirmi Yedi"
Halalas = " & 27/100 Riyal"
Dava "Yirmi Sekiz"
Halalas = " & 28/100 Riyal"
Dava "Yirmi Dokuz"
Halalas = " & 29/100 Riyal"
"Otuz" vakası
Halalas = " & 30/100 Riyal"
Dava "Otuz Bir"
Halalas = " & 31/100 Riyal"
Dava "Otuz İki"
Halalas = " & 32/100 Riyal"
Dava "Otuz Üç"
Halalas = " & 33/100 Riyal"
"Otuz Dört" Davası
Halalas = " & 34/100 Riyal"
"Otuz Beş" Davası
Halalas = " & 35/100 Riyal"
Dava "Otuz Altı"
Halalas = " & 36/100 Riyal"
Dava "Otuz Yedi"
Halalas = " & 37/100 Riyal"
Dava "Otuz Sekiz"
Halalas = " & 38/100 Riyal"
Dava "Otuz Dokuz"
Halalas = " & 39/100 Riyal"
"Kırk" vakası
Halalas = " & 40/100 Riyal"
Dava "Kırk Bir"
Halalas = " & 41/100 Riyal"
Dava "Kırk İki"
Halalas = " & 42/100 Riyal"
Dava "Kırk Üç"
Halalas = " & 43/100 Riyal"
"Kırk Dört" Davası
Halalas = " & 44/100 Riyal"
"Kırk Beş" Davası
Halalas = " & 45/100 Riyal"
Dava "Kırk Altı"
Halalas = " & 46/100 Riyal"
Dava "Kırk Yedi"
Halalas = " & 47/100 Riyal"
Dava "Kırk Sekiz"
Halalas = " & 48/100 Riyal"
"Kırk Dokuz" vakası
Halalas = " & 49/100 Riyal"
"Elli" vakası
Halalas = " & 50/100 Riyal"
"Elli Bir" vakası
Halalas = " & 51/100 Riyal"
"Elli İki" Davası
Halalas = " & 52/100 Riyal"
Dava "Elli Üç"
Halalas = " & 53/100 Riyal"
Dava "Elli Dört"
Halalas = " & 54/100 Riyal"
"Elli Beş" Davası
Halalas = " & 55/100 Riyal"
Dava "Elli Altı"
Halalas = " & 56/100 Riyal"
"Elli Yedi" vakası
Halalas = " & 57/100 Riyal"
"Elli Sekiz" vakası
Halalas = " & 58/100 Riyal"
"Elli Dokuz" vakası
Halalas = " & 59/100 Riyal"
"Altmış" vakası
Halalas = " & 60/100 Riyal"
Dava "Altmış Bir"
Halalas = " & 61/100 Riyal"
Dava "Altmış İki"
Halalas = " & 62/100 Riyal"
Dava "Altmış Üç"
Halalas = " & 63/100 Riyal"
Dava "Altmış Dört"
Halalas = " & 64/100 Riyal"
Dava "Altmış Beş"
Halalas = " & 65/100 Riyal"
Dava "Altmış Altı"
Halalas = " & 66/100 Riyal"
Dava "Altmış Yedi"
Halalas = " & 67/100 Riyal"
Dava "Altmış Sekiz"
Halalas = " & 68/100 Riyal"
Dava "Altmış Dokuz"
Halalas = " & 69/100 Riyal"
"Yetmiş" vakası
Halalas = " & 70/100 Riyal"
"Yetmiş Bir" vakası
Halalas = " & 71/100 Riyal"
Dava "Yetmiş İki"
Halalas = " & 72/100 Riyal"
Dava "Yetmiş Üç"
Halalas = " & 73/100 Riyal"
Dava "Yetmiş Dört"
Halalas = " & 74/100 Riyal"
"Yetmiş Beş" Davası
Halalas = " & 75/100 Riyal"
Dava "Yetmiş Altı"
Halalas = " & 76/100 Riyal"
Dava "Yetmiş Yedi"
Halalas = " & 77/100 Riyal"
Dava "Yetmiş Sekiz"
Halalas = " & 78/100 Riyal"
"Yetmiş Dokuz" vakası
Halalas = " & 79/100 Riyal"
"Seksen" vakası
Halalas = " & 80/100 Riyal"
Dava "Seksen Bir"
Halalas = " & 81/100 Riyal"
Dava "Seksen İki"
Halalas = " & 82/100 Riyal"
Dava "Seksen Üç"
Halalas = " & 83/100 Riyal"
Dava "Seksen Dört"
Halalas = " & 84/100 Riyal"
Dava "Seksen Beş"
Halalas = " & 85/100 Riyal"
Dava "Seksen Altı"
Halalas = " & 86/100 Riyal"
Dava "Seksen Yedi"
Halalas = " & 87/100 Riyal"
Dava "Seksen Sekiz"
Halalas = " & 88/100 Riyal"
Dava "Seksen Dokuz"
Halalas = " & 89/100 Riyal"
"Doksan" vakası
Halalas = " & 90/100 Riyal"
Dava "Doksan Bir"
Halalas = " & 91/100 Riyal"
Dava "Doksan İki"
Halalas = " & 92/100 Riyal"
Dava "Doksan Üç"
Halalas = " & 93/100 Riyal"
Dava "Doksan Dört"
Halalas = " & 94/100 Riyal"
Dava "Doksan Beş"
Halalas = " & 95/100 Riyal"
Dava "Doksan Altı"
Halalas = " & 96/100 Riyal"
Dava "Doksan Yedi"
Halalas = " & 97/100 Riyal"
Dava "Doksan Sekiz"
Halalas = " & 98/100 Riyal"
Dava "Doksan Dokuz"
Halalas = " & 99/100 Riyal"


Else Kılıf
Halalas = " & " & Halalas & " Halalas"
Select End
SpellBilling = Riyaller ve Halalalar
son İşlevi


' 100-999 arasındaki bir sayıyı metne dönüştürür
İşlev GetHundreds(ByVal MyNumber)
Sonucu Dize Olarak Karart
Val(MyNumber) = 0 ise Fonksiyondan Çık
MyNumber = Sağ ("000" ve MyNumber, 3)
' Yüzlerce basamağı çevir.
Eğer Orta(MyNumber, 1, 1) <> "0" Sonra
Sonuç = GetDigit(Mid(MyNumber, 1, 1)) & " Yüz "
Eğer son
' Onlarca ve birler basamağını dönüştürün.
Eğer Orta(MyNumber, 2, 1) <> "0" Sonra
Sonuç = Sonuç ve GetTens(Mid(MyNumber, 2))
başka
Sonuç = Sonuç ve GetDigit(Mid(MyNumber, 3))
Eğer son
GetHundreds = Sonuç
son İşlevi

' 10'dan 99'a kadar bir sayıyı metne dönüştürür.
İşlev GetTens(TensText)
Sonucu Dize Olarak Karart
Result = "" ' Geçici işlev değerini sıfırlayın.
Eğer Val(Left(TensText, 1)) = 1 O halde ' 10-19 arası bir değer ise...
Vaka Seç Val(TensText)
Durum 10: Sonuç = "On"
Durum 11: Sonuç = "Onbir"
Vaka 12: Sonuç = "On iki"
Vaka 13: Sonuç = "On üç"
Vaka 14: Sonuç = "Ondört"
Vaka 15: Sonuç = "Onbeş"
Vaka 16: Sonuç = "Onaltı"
Vaka 17: Sonuç = "Onyedi"
Vaka 18: Sonuç = "Onsekiz"
Vaka 19: Sonuç = "Ondokuz"
Else Kılıf
Select End
Else ' 20-99 arası bir değer ise...
Vaka Seç Val(Sol(TensText, 1))
Durum 2: Sonuç = "Yirmi"
Durum 3: Sonuç = "Otuz"
Durum 4: Sonuç = "Kırk"
Durum 5: Sonuç = "Elli"
Durum 6: Sonuç = "Altmış"
Durum 7: Sonuç = "Yetmiş"
Durum 8: Sonuç = "Seksen"
Durum 9: Sonuç = "Doksan"
Else Kılıf
Select End
Sonuç = Sonuç ve GetDigit _
(Right(TensText, 1)) ' Birlerin yerini al.
Eğer son
GetTens = Sonuç
son İşlevi

' 1'dan 9'a kadar bir sayıyı metne dönüştürür.
İşlev GetDigit(Rakam)
Vaka Seç Val(Rakam)
Durum 1: GetDigit = "Bir"
Durum 2: GetDigit = "İki"
Durum 3: GetDigit = "Üç"
Durum 4: GetDigit = "Dört"
Durum 5: GetDigit = "Beş"
Durum 6: GetDigit = "Altı"
Durum 7: GetDigit = "Yedi"
Durum 8: GetDigit = "Sekiz"
Durum 9: GetDigit = "Dokuz"
Başka Durum: GetDigit = ""
Select End
son İşlevi
Bu yorum sitedeki moderatör tarafından en aza indirildi
Tüm Excell Çalışma Kitabını uygulamam gerekiyor. Bu kodlamayı tüm excel çalışma kitaplarına nasıl uygulayabilirim.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Rupi On Dört Bin Sekiz Yüz Yetmiş Beş Yalnızca son tutarda kelime ve örnek olmalıdır
Sadece On Dört Bin Sekiz Yüz Yetmiş Beş Rupi
Bu yorum sitedeki moderatör tarafından en aza indirildi
10 crore'dan fazla okuyamıyor.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bir Lac Altmış Dokuz Bin Seksen Bir ve Kırk İki Paise - Düzgün dönüştürülmedi. Ayrıca yukarıdaki rakam yuvarlandığında dönüştürülmedi.
Bu yorum sitedeki moderatör tarafından en aza indirildi
KOD İÇİN TEŞEKKÜRLER...
Bu yorum sitedeki moderatör tarafından en aza indirildi
Kodlama için teşekkürler. Uyguladım ve Çalışması. Ancak, yalnızca o belirli çalışma kitabı için geçerlidir. Tüm Excell Çalışma Kitabını uygulamam gerekiyor. Bu kodlama tüm excel çalışma kitaplarına nasıl uygulanır?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,SivaG
Evet, bu kod Kullanıcı Tanımlı Fonksiyondur, formülü dosyalara tek tek uygulamalısınız, birden fazla çalışma kitabına uygulanacak bir koda ihtiyacınız varsa, tüm numaralara uygulanacaktır, böylece tüm numaralar değişecektir. Ve kod geri almayı destekleyemez, bazı güvenlik riskleri vardır. Bunu yapmanız tavsiye edilmez. Teşekkürler!
Bu yorum sitedeki moderatör tarafından en aza indirildi
"Rupi" kelimesini nasıl kaldırabilirim? Normalde çek yapraklarında zaten "Rupi" kelimesi bulunur.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Sakarya
Sorununuzu çözmek için lütfen aşağıdaki kodu uygulayın:
Public Function RupeeFormat(SNum As String)
'Updateby Extendoffice
Dim xDPInt As Integer
Dim xArrPlace As Variant
Dim xRStr_Paisas As String
Dim xNumStr As String
Dim xF As Integer
Dim xTemp As String
Dim xStrTemp As String
Dim xRStr As String
Dim xLp As Integer
xArrPlace = Array("", "", " Thousand ", " Lacs ", " Crores ", " Trillion ", "", "", "", "")
On Error Resume Next
If SNum = "" Then
  RupeeFormat = ""
  Exit Function
End If
xNumStr = Trim(Str(SNum))
If xNumStr = "" Then
  RupeeFormat = ""
  Exit Function
End If

xRStr = ""
xLp = 0
If (xNumStr > 999999999.99) Then
    RupeeFormat = "Digit excced Maximum limit"
    Exit Function
End If
xDPInt = InStr(xNumStr, ".")
If xDPInt > 0 Then
    If (Len(xNumStr) - xDPInt) = 1 Then
       xRStr_Paisas = RupeeFormat_GetT(Left(Mid(xNumStr, xDPInt + 1) & "0", 2))
    ElseIf (Len(xNumStr) - xDPInt) > 1 Then
       xRStr_Paisas = RupeeFormat_GetT(Left(Mid(xNumStr, xDPInt + 1), 2))
    End If
        xNumStr = Trim(Left(xNumStr, xDPInt - 1))
    End If
    xF = 1
    Do While xNumStr <> ""
        If (xF >= 2) Then
            xTemp = Right(xNumStr, 2)
        Else
            If (Len(xNumStr) = 2) Then
                xTemp = Right(xNumStr, 2)
            ElseIf (Len(xNumStr) = 1) Then
                xTemp = Right(xNumStr, 1)
            Else
                xTemp = Right(xNumStr, 3)
            End If
        End If
        xStrTemp = ""
        If Val(xTemp) > 99 Then
            xStrTemp = RupeeFormat_GetH(Right(xTemp, 3), xLp)
            If Right(Trim(xStrTemp), 3) <> "Lac" Then
            xLp = xLp + 1
            End If
        ElseIf Val(xTemp) <= 99 And Val(xTemp) > 9 Then
            xStrTemp = RupeeFormat_GetT(Right(xTemp, 2))
        ElseIf Val(xTemp) < 10 Then
            xStrTemp = RupeeFormat_GetD(Right(xTemp, 2))
        End If
        If xStrTemp <> "" Then
            xRStr = xStrTemp & xArrPlace(xF) & xRStr
        End If
        If xF = 2 Then
            If Len(xNumStr) = 1 Then
                xNumStr = ""
            Else
                xNumStr = Left(xNumStr, Len(xNumStr) - 2)
            End If
       ElseIf xF = 3 Then
            If Len(xNumStr) >= 3 Then
                 xNumStr = Left(xNumStr, Len(xNumStr) - 2)
            Else
                xNumStr = ""
            End If
        ElseIf xF = 4 Then
          xNumStr = ""
    Else
        If Len(xNumStr) <= 2 Then
        xNumStr = ""
    Else
        xNumStr = Left(xNumStr, Len(xNumStr) - 3)
        End If
    End If
        xF = xF + 1
Loop
    If xRStr = "" Then
       xRStr = "No Rupees"
    Else
       xRStr = xRStr
    End If
    If xRStr_Paisas <> "" Then
       xRStr_Paisas = " and " & xRStr_Paisas & " Paisas"
    End If
    RupeeFormat = xRStr & xRStr_Paisas & " Only"
    End Function
Function RupeeFormat_GetH(xStrH As String, xLp As Integer)
Dim xRStr As String
If Val(xStrH) < 1 Then
    RupeeFormat_GetH = ""
    Exit Function
Else
   xStrH = Right("000" & xStrH, 3)
   If Mid(xStrH, 1, 1) <> "0" Then
        If (xLp > 0) Then
         xRStr = RupeeFormat_GetD(Mid(xStrH, 1, 1)) & " Lac "
        Else
         xRStr = RupeeFormat_GetD(Mid(xStrH, 1, 1)) & " Hundred "
        End If
    End If
    If Mid(xStrH, 2, 1) <> "0" Then
        xRStr = xRStr & RupeeFormat_GetT(Mid(xStrH, 2))
    Else
        xRStr = xRStr & RupeeFormat_GetD(Mid(xStrH, 3))
    End If
End If
    RupeeFormat_GetH = xRStr
End Function
Function RupeeFormat_GetT(xTStr As String)
    Dim xTArr1 As Variant
    Dim xTArr2 As Variant
    Dim xRStr As String
    xTArr1 = Array("Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
    xTArr2 = Array("", "Twenty", "Thirty", "Forty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
    Result = ""
    If Val(Left(xTStr, 1)) = 1 Then
        xRStr = xTArr1(Val(Mid(xTStr, 2, 1)))
    Else
        If Val(Left(xTStr, 1)) > 0 Then
            xRStr = xTArr2(Val(Left(xTStr, 1)) - 1)
        End If
        xRStr = xRStr & RupeeFormat_GetD(Right(xTStr, 1))
    End If
      RupeeFormat_GetT = xRStr
End Function
Function RupeeFormat_GetD(xDStr As String)
Dim xArr_1() As Variant
    xArr_1 = Array(" One", " Two", " Three", " Four", " Five", " Six", " Seven", " Eight", " Nine", "")
    If Val(xDStr) > 0 Then
        RupeeFormat_GetD = xArr_1(Val(xDStr) - 1)
    Else
        RupeeFormat_GetD = ""
    End If
End Function



Lütfen deneyin, umarım size yardımcı olabilir!
Bu yorum sitedeki moderatör tarafından en aza indirildi
çok teşekkürler... 🙂
Bu yorum sitedeki moderatör tarafından en aza indirildi
Ancak bu yalnızca bir excel için geçerlidir. Bu formülü diğer excel'e girersem, bu çalışmıyor
bunun çözümü nedir
lütfen geri dönün
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,

Birkaç çalışma kitabınız varsa, kodu birkaç çalışma kitabına kopyalamanız gerekir.
Yalnızca bir çalışma kitabına kopyalarsanız, diğer çalışma kitaplarında çalışmaz. 😀
Lütfen deneyin, teşekkürler!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Çok teşekkürler çok Yararlı
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Efendim, Bunu her excel çalışma sayfası için varsayılan olarak ayarlamak mümkün mü, değil mi?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Mukesh

Evet, kod vba pencere modülüne kopyalandığı sürece, formül tüm çalışma kitabına uygulanabilir.
Ancak çalışma kitabını kapatırken, onu farklı kaydetmelisiniz. Excel Makro Etkin Çalışma Kitabı dosya formatı.
Lütfen bir deneyin, teşekkürler!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bir çok kez denedim çalışmıyor. Lütfen yardım et
Buraya henüz hiç yorum yapılmamış
Lütfen yorum yazın
Misafir olarak yayınlama
×
Bu gönderiyi değerlendirin:
0   Karakterler
Önerilen Konumlar

Bizi takip et

Telif Hakkı © 2009 - www.extendoffice.com. | Tüm hakları Saklıdır. Tarafından desteklenmektedir ExtendOffice. | | | Site Haritası
Microsoft ve Office logosu, Microsoft Corporation'ın Amerika Birleşik Devletleri ve / veya diğer ülkelerdeki ticari markaları veya tescilli ticari markalarıdır.
Sectigo SSL ile korunmaktadır