VB / VBA - रोमन संख्या को अरबी में बदलें
ये फ़ंक्शन अरबी संख्या प्रारूप (1969) में रोमन "अक्षरों" (MCMLXIX) में व्यक्त संख्याओं के रूपांतरण की अनुमति देते हैं। ये प्रक्रिया एक्सेल के लिए कस्टम फ़ंक्शन के रूप में और उपयोगकर्ता के लिए VBA में उपलब्ध हैं। VBA कोड VB6 के साथ संगत है।
एक्सेल के लिए समारोह
एक सामान्य मॉड्यूल में नीचे कोड पेस्ट करें, जैसे मॉड्यूल 1।
डिम Rm के रूप में स्ट्रिंग सार्वजनिक समारोह RomainArabe (सी रेंज के रूप में) इंटर्जर के रूप में डिम टीबी डिम अरब के रूप में इंटीगर डिम के रूप में बाइट, ए के रूप में पूर्णांक, यूटीबी के रूप में पूर्णांक अगर सी = "" तो रोमैनअराबे = 0: एग्जिट फंक्शन रीडम टीबी (0) .Volatile i = 1: Utb = 1: Arab = 0 Rm = प्रतिस्थापित (C, "", "") 'सप्रेमी लेस एस्पेस éventuels Rm = UCase (Rm)' मिले एन मजस्सेसी सेनसेयर जबकि मैं <= लेन (आरएम) 'ट्रेस लेस लेट्रेस यूनी अनडे रिडीम प्रोटेक्ट टीबी (यूटीबी) ए = एनबेल्ट्रे (आई) टीबी (यूटीबी) = ए * वेलुरेल्ट्रे (मिड (आरएम, आई, 1)) डीबग.प्रिंट टीबी (यूटीबी) आई = आई + ए यूटीबी = Utb + 1 वेंड रिडीम टीबी (Utb) का संरक्षण करें: i = 1 जबकि मैं <UBound (TB) यदि TB (i) <TB (i + 1) तो अरब = अरब + टीबी (i + 1) - TB (i) i = i + 2 + Else Arab = Arab + TB (i) i = i + 1 समाप्ति यदि Debug.Print Arab Wend RomainArabe = Arab End फंक्शन फंक्शन NBlettre (बाइट के रूप में डेब) के रूप में बाइट डिम मैं Integer, L के रूप में स्ट्रिंग NBlettre = 1 एल = मिड (आरएम, डेब, 1) के लिए मैं = डेब + 1 से लेन (आरएम) अगर मिड (आरएम, आई, 1) = एल तो एनबीलेट्रे = एनबलेट्रे + 1 एग्जिट फंक्शन एंड यदि अंतिम समाप्ति समारोह फंक्शन वेलुरल्ट्रे ( एल स्ट्रिंग के रूप में ) इंटेगर डिम रोमैन, अर्बे के रूप में, मैं बाइट रोमैन = ऐरे ("I", "V", "X", "L", "C", "D", "M") अराब = Array (1, 5), १०, ५०, १००, ५००, १०००) के लिए i = ० से ६ तक अगर L = रोमैन (i) तो वलेउलरेट्रे = अर्बे (i) कार्य समाप्त होने पर बाहर निकलें एक्सेल स्प्रेडशीट में रखे जाने वाले सूत्र का उदाहरण
'= RomainArabic (A3)
VBA / VB6 कोड
एक सामान्य मॉड्यूल में नीचे दिए गए कोड को पेस्ट करें, जैसे VBA के लिए Module1 या VB6 के लिए Module.bas में
विकल्प स्पष्ट डिम Rm के रूप में स्ट्रिंग सार्वजनिक समारोह TraduitRomain (Rm) इंटेगर डिम टीबी के रूप में मंद टीबी के रूप में मंद अरब मैं बाइट के रूप में, एक पूर्णांक के रूप में, इंटीगर रेदिम टीबी के रूप में Utb (0) i = 1 = Utb = 1 आरएम = बदलें (आरएम, ) "", "") '' सप्रेईम लेस एस्पेस éventuels Rm = UCase (Rm) '' एन मेजसक्यूल सी नीसेयर से मिला, जबकि <= लेन (आरएम) '' ट्रेस लेस लेट्रेस एक यू रीडेम प्रोटेक्ट टीबी (यूटीबी) ए = एनबेल्ट्रे (आई) TB (Utb) = A * ValeurLettre (Mid (Rm, i, 1)) Debug.Print TB (Utb) i = i + A Utb = Utb + 1 Wend ReDim Preserve TB (Utb): i = 1 जबकि मैं <UBound (टीबी) यदि टीबी (i) <टीबी (i + 1) तब अरब = अरब + टीबी (i + 1) - टीबी (i) i = i + 2 + अरब अरब = अरब + टीबी (i) i = i + 1 अंत यदि डिबग। क्रिंट अरब वेंड ट्रेडरोमैन = अरब एंड फंक्शन निजी समारोह NBlettre (बाइट के रूप में डेब) के रूप में बाइट डिम मैं पूर्णांक के रूप में, एल के रूप में स्ट्रिंग NBlettre = 1 एल = मिड (आरएम, डेब, 1) के लिए मैं = डेब + 1 के लिए लेन (आरएम) यदि मिड (आरएम, आई, 1) = एल तो एनबीलेटेर = एनबेल्ट्रे + 1 एग्जिट फंक्शन एंड यदि अगले अंत फ़ंक्शन निजी फ़ंक्शन वेलेलुरेट्रे (एल एस स्ट्रिंग के रूप में) इंटम डिम रोमैन, अर्बे, मैं बाइट रोमैन के रूप में = ऐरे ("I", "V", "X", "L", "C", "D", "M") अर्बे = Array (1, 5, 10, 50, 100, 500, 1000) i = 0 से 6 यदि L = रोमैन (i) तब ValeurLettre = Arabe (i) कार्य समाप्त होने पर बाहर निकलना फ़ंक्शन कॉल का उदाहरण:
उप AppelEnArabic () डिम आर अस स्ट्रिंग आर = "MMMCMIC" MsgBox R & "en chiffre arabe donnerait" & TraduitRomain (R) एंड सब