Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

gelöst Arabische Zahlen in Römische Rechnen in VB6

Mitglied: JuanJespar

JuanJespar (Level 1) - Jetzt verbinden

29.06.2009, aktualisiert 09:30 Uhr, 3879 Aufrufe, 12 Kommentare

Hab das Problem das ich eine Rechenfunktion von Arabischen in Römischen Zahlen schreiben muss.
umgedreht hab ich schon.
Hat jemand da nen ansatz?
mfg
Juan

Function von Römisch in Arabisch

01.
Function Rom2Arab(ByVal RZahl As String) As Long 
02.
Dim i As Integer 
03.
Dim lngTeilWert As Long 
04.
Dim lngTeilWert2 As Long 
05.
Dim lngGesamtWert As Long 
06.
     
07.
    lngTeilWert = 0 
08.
    lngTeilWert2 = 0 
09.
    lngGesamtWert = 0 
10.
     
11.
    For i = 1 To Len(RZahl) 
12.
        Select Case Mid(RZahl, i, 1) 
13.
            Case "M" 
14.
                lngTeilWert = 1000 
15.
            Case "D" 
16.
                lngTeilWert = 500 
17.
            Case "C" 
18.
                lngTeilWert = 100 
19.
            Case "L" 
20.
                lngTeilWert = 50 
21.
            Case "X" 
22.
                lngTeilWert = 10 
23.
            Case "V" 
24.
                lngTeilWert = 5 
25.
            Case "I" 
26.
                lngTeilWert = 1 
27.
        End Select 
28.
         
29.
        If lngTeilWert2 < lngTeilWert Then 
30.
            lngGesamtWert = lngGesamtWert - lngTeilWert2 * 2 + lngTeilWert 
31.
        Else 
32.
            lngGesamtWert = lngGesamtWert + lngTeilWert 
33.
        End If 
34.
        lngTeilWert2 = lngTeilWert 
35.
    Next i 
36.
     
37.
    Rom2Arab = lngGesamtWert 
38.
End Function
Mitglied: TsukiSan
29.06.2009 um 12:02 Uhr
....auch ein fröhliches Hallo,

wie wäre es mit
01.
.        Select Case Mid(RZahl, i, 1)  
02.
            Case 1000 
03.
                lngTeilWert = "M"  
04.
            Case 500  
05.
                lngTeilWert = "D"  
06.
            Case 100  
07.
                lngTeilWert = "C" 
08.
            Case 50  
09.
                lngTeilWert = "L" 
10.
            Case 10  
11.
                lngTeilWert = "X" 
12.
            Case 5  
13.
                lngTeilWert = "V" 
14.
            Case 1  
15.
                lngTeilWert = "I" 
16.
        End Select 
???????

Gruß

Tsuki
Bitte warten ..
Mitglied: Logan000
29.06.2009 um 16:32 Uhr
Moin Moin

Sorry Tsuki ganz so einfach ist das nun auch nicht.

Ich hab diese Funktion mal vor längerer Zeit geschrieben.
Soweit ich das sagen kann funktioniert sie ganz hervorragend.
(Falls jemand eine elegqanteren/ besserenWeg hat, immer her damit)
01.
Public Function NumInRoman(intArabic As Long) As String 
02.
 
03.
    Dim szRoman As String 
04.
    Dim Roman As Variant 
05.
    Dim Arabic As Variant 
06.
    Dim i As Integer 
07.
    Dim szArabic As String 
08.
    Dim szPotenz As String 
09.
    Dim intPotenz As Long 
10.
    Dim intAnz As Integer 
11.
     
12.
On Error Resume Next 
13.
     
14.
    If intArabic = 0 Then Exit Function 
15.
      
16.
    Roman = Array("I", "V", "X", "L", "C", "D", "M") 
17.
    Arabic = Array(1, 5, 10, 50, 100, 500, 1000) 
18.
     
19.
    szArabic = CStr(intArabic) 
20.
    szPotenz = Left(szArabic, 1) 
21.
    While Len(szPotenz) < Len(szArabic) 
22.
        szPotenz = szPotenz & "0" 
23.
    Wend 
24.
    intPotenz = CLng(szPotenz) 
25.
     
26.
    i = 6 
27.
    While i >= 0 
28.
        If intPotenz = Arabic(i) Then 
29.
            szRoman = Roman(i) & NumInRoman(intArabic - intPotenz) 
30.
            GoTo Exithandler 
31.
        End If 
32.
        i = i - 1 
33.
    Wend 
34.
    If (intPotenz + Arabic(4)) Mod 100 = 0 Then 
35.
        szRoman = Roman(4) & NumInRoman(intArabic + Arabic(4)) 
36.
        GoTo Exithandler 
37.
    End If 
38.
    If (intPotenz + Arabic(2)) Mod 10 = 0 Then 
39.
        szRoman = Roman(2) & NumInRoman(intArabic + Arabic(2)) 
40.
        GoTo Exithandler 
41.
    End If 
42.
    If (intPotenz + Arabic(0)) Mod 10 = 0 Then 
43.
        szRoman = Roman(0) & NumInRoman(intArabic + Arabic(0)) 
44.
        GoTo Exithandler 
45.
    End If 
46.
    i = Len(szArabic) 
47.
    Select Case Left(szPotenz, 1) 
48.
    Case "9" 
49.
        szRoman = Roman(i - 2) & Roman(i) & NumInRoman(intArabic - intPotenz) 
50.
        GoTo Exithandler 
51.
    Case "4" 
52.
        szRoman = Roman(i - 1) & Roman(i) & NumInRoman(intArabic - intPotenz) 
53.
        GoTo Exithandler 
54.
    Case Is > "4" 
55.
        szRoman = Roman(i) 
56.
        intAnz = Left(szPotenz, 1) Mod 5 
57.
        While intAnz > 0 
58.
            szRoman = szRoman & Roman(i - 1) 
59.
            intAnz = intAnz - 1 
60.
        Wend 
61.
        szRoman = szRoman & NumInRoman(intArabic - intPotenz) 
62.
        GoTo Exithandler 
63.
    Case Else 
64.
        szRoman = Roman(i - 1) & NumInRoman(intArabic - Arabic(i - 1)) 
65.
    End Select 
66.
Exithandler: 
67.
    NumInRoman = szRoman 
68.
    Err.Clear                                                           ' Evtl. Error clearen 
69.
End Function
Gruß L.
Bitte warten ..
Mitglied: 76109
30.06.2009 um 08:39 Uhr
Hallo Logan000!

Ich bastle gerade an einem Code und beim testen, zu dem ich Deinen Code zur Controlle verwende, ist mir aufgefallen, dass Dein Code bei Zahlen ab 2000 austickt und nur noch Das Zeichen "C" schreibt. Bei der Zahl 399 zeigt er das Ergebnis (CCDXCIX) und bei Zahl 20 (XXXL)?

Gruß Dieter
Bitte warten ..
Mitglied: 76109
30.06.2009 um 09:24 Uhr
Hallo zusammen!

Code nochmal entfernt. Habe noch einen klitzekleinen Fehler gefunden.

Gruß Dieter
Bitte warten ..
Mitglied: 76109
30.06.2009 um 10:44 Uhr
Hallo zusammen!

So, jetzt müsste es funktionieren. Habe beim letzten Code die 5er-Reihen übersehen.
01.
Function ArabicToRoman(ByVal Zahl As Integer) As String 
02.
     
03.
    Dim Roman As Variant, Arabic As Variant, Summen As Variant 
04.
    Dim i As Integer, x As Integer, Test1 As Integer, Test2 As Integer 
05.
         
06.
    Summen = Array(0, 0, 0, 0, 0, 0, 0) 
07.
    Arabic = Array(1000, 500, 100, 50, 10, 5, 1, 1) 
08.
    Roman = Array("M", "D", "C", "L", "X", "V", "I", "") 
09.
                  
10.
    If Zahl <= 0 Or Zahl > 3999 Then Exit Function 
11.
     
12.
    For i = 0 To UBound(Summen) 
13.
        Test1 = Zahl \ Arabic(i):  Test2 = Zahl \ Arabic(i + 1):  Zahl = Zahl Mod Arabic(i)  
14.
       'Für Div ohne Rest mit \ anstatt / 
15.
  
16.
        If Test2 = 9 And Not (Roman(i + 1) = "D" Or Roman(i + 1) = "L" Or Roman(i + 1) = "V") Then 
17.
            Summen(i + 1) = Test2:  Zahl = Zahl Mod Arabic(i + 1): i = i + 1 
18.
        Else 
19.
            Summen(i) = Test1 
20.
        End If 
21.
             
22.
        If Zahl = 0 Then Exit For 
23.
    Next 
24.
    
25.
    For i = 0 To UBound(Summen) 
26.
        If Summen(i) = 4 Then 
27.
            Summen(i) = 0:  ArabicToRoman = ArabicToRoman & Roman(i) & Roman(i - 1) 
28.
        ElseIf Summen(i) = 9 Then 
29.
            Summen(i) = 0:  ArabicToRoman = ArabicToRoman & Roman(i) & Roman(i - 2) 
30.
        ElseIf Summen(i) > 0 Then 
31.
            For x = 1 To Summen(i):  ArabicToRoman = ArabicToRoman & Roman(i):  Next 
32.
        End If 
33.
    Next 
34.
End Function
Gruß Dieter

[edit] Auf Anregung von Logan000, die Zahlen auf max 3999 begrenzt. [/edit]
Bitte warten ..
Mitglied: Logan000
30.06.2009 um 11:43 Uhr
Moin Moin

Der Code ist super, Dieter.
Ich frag mich gerade, was ich damals fürn Kot produziert habe.

Eine Anmerkung zu deiner Funktion. Du soltest in Zeile 10, Zahlen über 3999 auschließen:
01.
... 
02.
If Zahl <= 0 Or Zahl > 3999Then Exit Function  
03.
...
Da bei Römischen Zahlen sich jedes Zeichen max. 3x wiederholen darf, wäre das eigentlich auch die Größte römische Zahl.
Falls Du größere Zahlen zulassen möchtest, must du in Zeile 27 was machen, denn da würde die Funktion bei Zahl = 4000 aussteigen.

Gruß L.
Bitte warten ..
Mitglied: 76109
30.06.2009 um 13:05 Uhr
Hallo Logan000!

Danke für den Hinweis. Soweit habe ich nicht getestet.

Also, ich muss gestehen, dass ich Anfangs auch noch ganz schön im Nebel Stand. Aber dann kam mir doch noch eine kleine Erleuchtung.

Am Anfang, als ich ein paar Zahlen in Deinen Code eingegeben hatte, stimmte es noch. Erst als ich mit einer For-Schleife in Hunderter Schritten, beide Ergebnisse in Debug.Print verglichen habe, ist mir der Fehler aufgefallen.

Gruß Dieter
Bitte warten ..
Mitglied: JuanJespar
30.06.2009 um 14:45 Uhr
Danke Leute.

Die Function sieht wenigstens jetz plausibel aus.
i hab mich schon halb verrückt versucht an dem Code, andere Rechnung von Römisch auf Arabisch fand ich garnicht so schlimm aba von zahlen auf Römischen is schon komisch.

trotzdem thx
Bitte warten ..
Mitglied: 76109
30.06.2009 um 15:50 Uhr
Hallo JuanJespar!

Ja, da gebe ich Dir Recht. So aus dem Stehgreif habe ich das auch nicht hinbekommen.

Aber, wozu braucht man sowas eigenlich?

Gruß Dieter
Bitte warten ..
Mitglied: JuanJespar
30.06.2009 um 16:01 Uhr
Ich brauche das in meinem Praktikum(hoffentlich bald ausbildung)

ich brauch vba für den einsatz in ErkennungsEngine.

daher muss i erstmal vb lern.das sind meistens Aufgaben die ich von meinen Ausbilder bekomme.

und wenn ich nicht weiter komm kann mann ja mal net fragen.

Gruß Juan
Bitte warten ..
Mitglied: 76109
30.06.2009 um 17:01 Uhr
Hallo JuanJespar!

Danke für die Antwort.

Na, da kannst Du ja jetzt Punkte sammeln Und für Deine Ausbildung drücke ich Dir mal die Daumen.

Gruß Dieter
Bitte warten ..
Mitglied: JuanJespar
01.07.2009 um 11:37 Uhr
Hallo Didi.

Ja danke das hoffe ich auch.

Vlt höhren wir ja noch öfters von einander, scheinst ja schon recht gut bewandert in VB zu sein
Bitte warten ..
Ähnliche Inhalte
JavaScript

Javascript rechnen mir sehr sehr großen Zahlen

Frage von it4baerJavaScript3 Kommentare

Hallo, ist es möglich in Javascript mit extrem großen Zahlen zu rechnen . z.B. 783^98 bekannterweise werden ja normale ...

Peripheriegeräte

Arabische Tastatur benutzen

gelöst Frage von SarekHLPeripheriegeräte23 Kommentare

Hallo zusammen, unsere Kirchengemeinde möchte in ihrem Computerraum (Windows 7 Enterprise - PCs) ein "Kommunikationscafé" für Flüchtlinge einrichten, wo ...

Visual Studio

Rechnen mit sehr großen Zahlen (über 100.000 Stellen) mit Komma

gelöst Frage von Aicher1998Visual Studio12 Kommentare

Hallo ich hab da mal ein kleines Provlem. Ich müsste mit sehr langen Zahlen rechnen (über 100.000 Stellen). Hab ...

Batch & Shell

In Batch Zählen

gelöst Frage von mavericklpBatch & Shell2 Kommentare

Guten Morgen zusammen, Ich habe ein kleines Problem mit einer Zählschleifer in der Batch Datei. Und zwar werden die ...

Neue Wissensbeiträge
Google Android

Googles "Android Enterprise Recommended" für Unternehmen

Information von kgborn vor 8 StundenGoogle Android3 Kommentare

Hier eine Information, die für Administratoren und Verantwortliche in Unternehmen, die für die Beschaffung und das Rollout von Android-Geräten ...

Sicherheit

Intel gibt neue Spectre V2-Microcode-Updates frei (20.02.2018)

Information von kgborn vor 9 StundenSicherheit

Intel hat zum 20. Februar 2018 weitere Microcode-Updates für OEMs freigegeben, um Systeme mit neueren Prozessoren gegen die Spectre ...

Microsoft
ARD-Doku - Das Microsoft Dilemma
Tipp von Knorkator vor 12 StundenMicrosoft3 Kommentare

Hallo zusammen, vor einigen Tagen lief in der ARD u.a. Reportage. Das Youtube Video dazu dürfte länger verfügbar sein. ...

Windows 10

Neue Sicherheitslücke in Windows 10 (Version 1709) durch Google öffentlich geworden

Information von kgborn vor 1 TagWindows 10

Vor ein paar Tagen haben Googles Sicherheitsforscher vom Projekt Zero eine Sicherheitslücke im Edge-Browser publiziert. Jetzt wurde eine weitere ...

Heiß diskutierte Inhalte
Windows Server
AD DS findet Domäne nicht, behebbar?
Frage von schapitzWindows Server40 Kommentare

Guten Tag, ich habe bei einem Kunden ein Problem mit den AD DS. Umgebung ist folgende: Windows Server 2016 ...

Router & Routing
LANCOM VPN CLIENT einrichten
Frage von Finchen961988Router & Routing27 Kommentare

Hallo, ich habe ein Problem und hoffe ihr könnt mir helfen, wir haben einen Kunden der hat einen Speedport ...

Router & Routing
ISC DHCP 2 Subnetze
gelöst Frage von janosch12Router & Routing19 Kommentare

Hallo, ich betreibe bei mir im Netzwerk einen ISC DHCP Server auf Debian, der DHCP verwaltet aktuell ein /24 ...

Switche und Hubs
Cisco SG350X-48 AdminIP in anderes VLAN
Frage von lcer00Switche und Hubs14 Kommentare

Hallo zusammen, ich habe ein Problem mir einem Cisco SG350X-48 bei der Erstinstallation wurde eine IP 192.168.0.254 (Default VLAN ...