Calcolo Ambo Lotto

Hai un problema con Excel?

Nuova discussione

Calcolo Ambo Lotto
di Diego (utente non iscritto) data: 13/01/2016 16:38:43
Buonasera a tutti,
vi posto un file di excel dove vengono calcolati gli ambi usciti su ruota di Bari, cioè gli ambi che sono usciti con maggiore frequenza. Questa macro è stata già postata tempo fà, ma per voi guru del VBA, volevo chiedere se qualcuno riusciva a modificare la macro in modo da fare calcolare l'uscita su tutte le ruote, quindi a creare quei range che calcolino sulle dieci ruote quali ambi sono piu' frequenti.
La macro calcola nel range D14:H621 riferito alla ruota di Bari le combinazioni di ambi, la macro la riporto qui sotto.
La macro dovrebbe essere modificata per avere sempre l'uscita degli ambi totali ma su tutte le ruote quindi nei range H:M; N:R; S:W; X:AB; AC:AG; AH:AL; AM:AQ; AR:AV; AW:BA

Ringrazio già in anticipo chi fosse interessato.
Grazie mille

Private Sub CommandButton1_Click()
Call AmboFrequente
End Sub
Sub AmboFrequente()
Dim ambo As String, ramb As Integer
Dim rig As Integer, urig As Long
Dim i As Long
Dim rng As Range, c As Range, xxx As Range
Set rng = Range("D14:H621")

Range("A:B").ClearContents

'For Each c In rng
'c.Value = Int((90 - 1 + 1) * Rnd + 1)
'Next c

urig = Range("H" & Rows.Count).End(xlUp).Row


i = 2

Cells(1, 1) = "AMBI"
Cells(1, 2) = "USCITE"

'Ambi

For rig = 14 To urig
        
    For ramb = 5 To 8
        
        If Cells(rig, 4).Value > Cells(rig, ramb).Value Then
        ambo = Cells(rig, 4).Value & "_" & Cells(rig, ramb).Value
        Else
        ambo = Cells(rig, ramb).Value & "_" & Cells(rig, 4).Value
        End If
        
        Set xxx = Range("A:A").Find(ambo, lookat:=xlWhole)
        If xxx Is Nothing Then
        Cells(i, 1) = ambo
        Cells(i, 2) = 1
        i = i + 1
        Else
        xxx.Offset(, 1).Value = xxx.Offset(, 1).Value + 1
        End If
        
    Next ramb

    For ramb = 6 To 8

        If Cells(rig, 5).Value > Cells(rig, ramb).Value Then
        ambo = Cells(rig, 5).Value & "_" & Cells(rig, ramb).Value
        Else
        ambo = Cells(rig, ramb).Value & "_" & Cells(rig, 5).Value
        End If
        
        Set xxx = Range("A:A").Find(ambo, lookat:=xlWhole)
        If xxx Is Nothing Then
        Cells(i, 1) = ambo
                Cells(i, 2) = 1

        i = i + 1
        Else
        xxx.Offset(, 1).Value = xxx.Offset(, 1).Value + 1
        End If
    
    Next ramb

    For ramb = 7 To 8
        If Cells(rig, 6).Value > Cells(rig, ramb).Value Then
        ambo = Cells(rig, 6).Value & "_" & Cells(rig, ramb).Value
        Else
        ambo = Cells(rig, ramb).Value & "_" & Cells(rig, 6).Value
        End If
        
        Set xxx = Range("A:A").Find(ambo, lookat:=xlWhole)
        If xxx Is Nothing Then
        Cells(i, 1) = ambo
                Cells(i, 2) = 1

        i = i + 1
        Else
        xxx.Offset(, 1).Value = xxx.Offset(, 1).Value + 1
        End If
                
    Next ramb
    
    If Cells(rig, 7).Value > Cells(rig, 8).Value Then
        ambo = Cells(rig, 7).Value & "_" & Cells(rig, 8).Value
        Else
        ambo = Cells(rig, 8).Value & "_" & Cells(rig, 7).Value
        End If
        
        Set xxx = Range("A:A").Find(ambo, lookat:=xlWhole)
        If xxx Is Nothing Then
        Cells(i, 1) = ambo
                Cells(i, 2) = 1

        i = i + 1
        Else
        xxx.Offset(, 1).Value = xxx.Offset(, 1).Value + 1
        End If
    
Next rig

Columns("A:B").Select
Selection.Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
ambo = [A2]

End Sub

di Diego (utente non iscritto) data: 15/01/2016 16:59:08
Buonasera,
trovo qualche anima pia disposta a revisionare il codice.....
Mille grazie......

Vuoi Approfondire?