Newsgroup: it.comp.lang.visual-basic
Titolo: algoritmo

Ho la necessità di fare questo tipo di calcolo:
es.:
16345676767766768
fare la somma di tutti i numeri pari e
tutti i numeri dispari.
Scusate ma sono inesperto potete aiutarmi?
Roberto.

 ha scritto nel messaggio
news:9ad0f6$100$1...@lacerta.tiscalinet.it...


 Roberto.
Devi eseguire i seguenti passi: Scorrere il numero cifra per cifra, poi
verificare se è pari o dispari e a seconda del risultato sommare la cifra a
una variabile contenete la somma dei pari o dei dispari.
In un form metti tre TextBox e un CommandButton, in text1 metti il numero
che vuoi eleborare e infine incolla il seguente codice:
Private Sub Command1_Click()
    Dim strNumero As String
    Dim lngPari As Long 'Variabile contenete la somma dei pari
    Dim lngDispari As Long 'Variabile contenete la somma dei dispari
    Dim lngCont As Long
    strNumero = Text1.Text  'Leggo il numero
    For lngCont = 1 To Len(strNumero) scorre le cifre una per volta
        If CInt(Mid(strNumero, lngCont, 1)) Mod 2 = 0 Then 'qui controllo se
è pari
            lngPari = lngPari + CLng(Mid(strNumero, lngCont, 1)) 'se si
sommo a lngPari
        Else
            lngDispari = lngDispari + CLng(Mid(strNumero, lngCont, 1))  'se
no sommo a lngDispari
        End If
    Next lngCont
    Text2.Text = lngPari 'Scrivo il totale dei pari
    Text3.Text = lngDispari 'Scrivo il totale dei dispari
End Sub
Così dovrebbe funzionare, il problema e con numeri grossi.
Ciao VB

 fare la somma di tutti i numeri pari e tutti i numeri dispari.
Option Explicit
Private Enum myOddEvenEnum
  myOdd
  myEven
End Enum
Private Function GetOddEvenSums( _
  ByVal Text As String _
) As Long()
  Dim lngOddEvenSums(myOdd To myEven) As Long
  Dim intIndex As Integer
  For intIndex = 1 To Len(Text) Step 2
    lngOddEvenSums(myOdd) _
      = lngOddEvenSums(myOdd) _
      + Val(Mid$(Text, intIndex, 1))
    lngOddEvenSums(myEven) _
      = lngOddEvenSums(myEven) _
      + Val(Mid$(Text, intIndex + 1, 1))
  Next
  GetOddEvenSums = lngOddEvenSums
End Function
Private Sub Main( _
)
  Dim lngOddEvenSums() As Long
  lngOddEvenSums = GetOddEvenSums("16345676767766768")
  Debug.Print lngOddEvenSums(myOdd)
  Debug.Print lngOddEvenSums(myEven)
End Sub
--
Ciao.
Maurizio
--------
?SPQR(C)
 X
--------


numero="1234567..."
for i=1 to len(numero)
if i mod 2=0 then
pari=pari+val(mid(numero,i,1))
else
dispari=dispari+val(mid(numero,i,1))
next i

 > fare la somma di tutti i numeri pari e tutti i numeri dispari.
[...]
Ti sottopongo alcune variazioni, spero interessanti o utili, sul tema. Ma
l'argomento non e` oramai piu` quello del tuo quesito, bensi`: del modo
tenuto da Visual Basic nel passare parametri a' funzioni.
Option Explicit
Private Enum myOddEvenEnum
  myOdd
  myEven
End Enum
Private Type OddEvenType
  Odd   As Long
  Even  As Long
End Type
Private Function GetOddEvenSums1( _
  ByVal Text As String _
) As Long()
  Dim lngIndex                        As Long
  Dim lngOddEvenSums(myOdd To myEven) As Long
  For lngIndex = 1 To Len(Text) Step 2
    lngOddEvenSums(myOdd) _
      = lngOddEvenSums(myOdd) _
      + Val(Mid$(Text, lngIndex, 1))
    lngOddEvenSums(myEven) _
      = lngOddEvenSums(myEven) _
      + Val(Mid$(Text, lngIndex + 1, 1))
  Next
  GetOddEvenSums1 = lngOddEvenSums
End Function
Private Function GetOddEvenSums2( _
  ByVal Text As String _
) As Long()
  Dim lngIndex                        As Long
  Dim lngOddEvenSums(myOdd To myEven) As Long
  For lngIndex = 1 To Len(Text) Step 2
    lngOddEvenSums(myOdd) _
      = lngOddEvenSums(myOdd) _
      + Format$((Mid$(Text, lngIndex, 1)), "@;0")
    lngOddEvenSums(myEven) _
      = lngOddEvenSums(myEven) _
      + Format$((Mid$(Text, lngIndex + 1, 1)), "@;0")
  Next
  GetOddEvenSums2 = lngOddEvenSums
End Function
Private Function GetOddEvenSums3( _
  ByRef Text() As Byte _
) As Long()
  Dim bytOffset                       As Byte
  Dim lngIndex                        As Long
  Dim lngOddEvenSums(myOdd To myEven) As Long
  bytOffset = Asc("0")
  On Error Resume Next
  For lngIndex = LBound(Text) To UBound(Text) Step 2
    lngOddEvenSums(myOdd) _
      = lngOddEvenSums(myOdd) _
      + Text(lngIndex) - bytOffset
    lngOddEvenSums(myEven) _
      = lngOddEvenSums(myEven) _
      + Text(lngIndex + 1) - bytOffset
  Next
  GetOddEvenSums3 = lngOddEvenSums
End Function
Private Function GetOddEvenSums4( _
  ByRef Text() As Byte _
) As OddEvenType
  Dim bytOffset As Byte
  Dim lngIndex  As Long
  bytOffset = Asc("0")
  On Error Resume Next
  For lngIndex = LBound(Text) To UBound(Text) Step 2
    With GetOddEvenSums4
      .Odd = .Odd + Text(lngIndex) - bytOffset
      .Even = .Even + Text(lngIndex + 1) - bytOffset
    End With
  Next
End Function
Private Sub Main( _
)
  Dim strText           As String
  Dim bytText()         As Byte
  Dim lngOddEvenSums()  As Long
  strText = "16345676767766768"
  bytText = StrConv(strText, vbFromUnicode)
  Debug.Print "GetOddEvenSums1:";
  lngOddEvenSums = GetOddEvenSums1(strText)
  Debug.Print lngOddEvenSums(myOdd); ";";
  Debug.Print lngOddEvenSums(myEven)
  Debug.Print "GetOddEvenSums2:";
  lngOddEvenSums = GetOddEvenSums2(strText)
  Debug.Print lngOddEvenSums(myOdd); ";";
  Debug.Print lngOddEvenSums(myEven)
  Debug.Print "GetOddEvenSums3:";
  lngOddEvenSums = GetOddEvenSums3(bytText)
  Debug.Print lngOddEvenSums(myOdd); ";";
  Debug.Print lngOddEvenSums(myEven)
  Debug.Print "GetOddEvenSums4:";
  With GetOddEvenSums4(bytText)
    Debug.Print .Odd; ";";
    Debug.Print .Even
  End With
