Binärcode und VBA-Excel...

Dieses Thema Binärcode und VBA-Excel... im Forum "Microsoft Office Suite" wurde erstellt von lonewulf, 17. Feb. 2005.

Thema: Binärcode und VBA-Excel... Also ich will eine VBA-Excel Anwenung schreiben, die mir, wenn ich eine Zahl eingebe, mir den dazugehörigen binäcode...

  1. Also ich will eine VBA-Excel Anwenung schreiben, die mir, wenn ich eine Zahl eingebe, mir den dazugehörigen binäcode ausgibt. bis jetzt habe ich zu diesem Problem noch keine lösung gefunden und ich hoffe ich finde sie hier.
    Als kleine Hilfe, wenns überhaupt eine ist. http://rapidshare.de/files-de/629405/Grey-Code.xls.html
    habe ich hier mal den Code und das einlesen


    Sub Einlesen()
    Dim zahl As Integer

    zahl = InputBox(Für welche Zahl soll der Code angezeigt werden?)

    End Sub

    hab ich schon ^^
     
  2. Hi lonewulf,

    folgendes Makro führt das gewünschte aus und kopiert die binäre Darstellung in die Zwischenablage.

    Gruß Matjes  ;)

    Code:
    Sub GanzeZahlBinaerAusgeben()
    'Eingabe: ganze Zahl
    'Ausgabe: Zahl in binärer Darstellung
    
      Dim s_Zahl As String, s As String, x As Long
      Dim l_zahl As Long, s_binaer As String, d_zahl As Double
      Dim l_ind As Long, l_potenz As Long
      Dim myDaten As DataObject
    
      Do
        s_Zahl = InputBox( _
          Für welche Zahl soll der Code angezeigt werden? & vbLf & _
          (Bereich: 0 - 2.147.483.646), _
          ganze Zahl in binäre Darstellung wandeln, _
          )
        If s_Zahl =  Then Exit Sub
        
       ->Prüfen auf ganze Zahl
        For x = 1 To Len(s_Zahl)
          s = Mid(s_Zahl, x, 1)
          Select Case s
            Case 0 To 9
            Case Else: GoTo MeldungKeineZahl
          End Select
        Next
        d_zahl = s_Zahl
        If d_zahl > 2147483646 Then GoTo MeldungKeineZahl
        Exit Do->Ist ganze Zahl
    MeldungKeineZahl:
        MsgBox (Bitte geben Sie eine ganze Zahl ein.)
      Loop
    
      l_zahl = s_Zahl
      
     ->Anzahl der binären Stellen
      l_ind = 0
      Do While 2 ^ l_ind < l_zahl
        l_ind = l_ind + 1
      Loop
      
     ->Binär codieren
      s_binaer = 
      For x = l_ind To 0 Step -1
        l_potenz = 2 ^ x
        If l_potenz > l_zahl Then
          s_binaer = s_binaer & 0
        Else
          s_binaer = s_binaer & 1
          l_zahl = l_zahl - l_potenz
        End If
      Next
      
      
     ->ggf. führende 0 abschneiden
      If s_binaer <> 0 Then
        If Left(s_binaer, 1) = 0 Then
          s_binaer = Right(s_binaer, Len(s_binaer) - 1)
        End If
      End If
      
     ->Meldung
      MsgBox ( _
        Die Zahl  & s_Zahl &  lautete binaer: & vbLf & vbLf & _
        s_binaer & vbLf & vbLf & _
        Die binäre Zahl ist in der Zwischenbalge)
      
     ->binären Wert in Zwischenablage kopieren
      Set myDaten = New DataObject
      myDaten.SetText s_binaer
      myDaten.PutInClipboard
    
    End Sub
     
  3. Hi lonewulf,

    hier die Version für den kompletten Wertebereich von->long'.

    Gruß Matjes :)
    Code:
    Sub GanzeZahlBinaerAusgeben2()
    'Eingabe: ganze Zahl (long)
    'Ausgabe: Zahl in binärer Darstellung
    
      Dim s_Zahl As String, s As String, x As Long
      Dim l_zahl As Long, s_binaer As String, d_zahl As Double
      Dim l_test As Long, s_tmp As String, l_cnt As Long
      Dim myDaten As DataObject
    
     ->Zahl eingeben (long)
      Do
        s_Zahl = InputBox( _
          Für welche Zahl soll der Code angezeigt werden? & vbLf & _
          (Bereich: -2.147.483.648 bis 2.147.483.647), _
          ganze Zahl in binäre Darstellung wandeln, _
          )
        If s_Zahl =  Then Exit Sub
        
       ->Prüfen auf ganze Zahl
        For x = 1 To Len(s_Zahl)
          s = Mid(s_Zahl, x, 1)
          Select Case s
            Case -: If x <> 1 Then GoTo MeldungKeineZahl
            Case 0 To 9
            Case Else: GoTo MeldungKeineZahl
            End Select
        Next
        d_zahl = s_Zahl
        If -2147483648# > d_zahl Or d_zahl > 2147483647 Then GoTo MeldungKeineZahl
        Exit Do->Ist ganze Zahl
    MeldungKeineZahl:
        MsgBox (Bitte geben Sie eine ganze Zahl ein.)
      Loop
      l_zahl = s_Zahl
    
     ->in binaer wandeln
      s_binaer = 
      For x = 30 To 0 Step -1
        l_test = l_zahl And (2 ^ x)
        If l_test > 0 Then s_binaer = s_binaer & 1 Else s_binaer = s_binaer & 0
      Next
     ->Bei negativer Zahl Bit für Vorzeichen setzen
      If l_zahl < 0 Then s_binaer = 1 & s_binaer
      
     ->ggf. führende 0en abschneiden
      For x = 1 To Len(s_binaer)
        If Left(s_binaer, 1) = 0 Then s_binaer = Right(s_binaer, Len(s_binaer) - 1)
      Next
      
     ->Formatierung:
     ->ein Leerzeichen vor jeweils 8 Digits
      s_tmp = : l_cnt = 0
      For x = Len(s_binaer) To 1 Step -1
        s_tmp = Mid(s_binaer, x, 1) & s_tmp
        l_cnt = l_cnt + 1
        If l_cnt Mod 8 = 0 And x <> 1 Then s_tmp =   & s_tmp
      Next x
      s_binaer = s_tmp
      
     ->Meldung
      MsgBox ( _
        Die Zahl  & s_Zahl &  lautete binaer: & vbLf & vbLf & _
        s_binaer & vbLf & vbLf & _
        Die binäre Zahl ist in der Zwischenablage)
      
     ->binären Wert in Zwischenablage kopieren
      Set myDaten = New DataObject: myDaten.SetText s_binaer: myDaten.PutInClipboard
    
    End Sub
     
Die Seite wird geladen...

Binärcode und VBA-Excel... - Ähnliche Themen

Forum Datum
VBA-Excel Variable in for-schleife hochzählen Microsoft Office Suite 27. Okt. 2008