Ciclo do while

Hai un problema con Excel?

Nuova discussione

Ciclo do while
di max (utente non iscritto) data: 23/03/2017 17:31:28
Ciao a tutti. Sto cercando di ovviare a una mancanza della tabella pivot che non dei raggruppamenti come desidero. Ho una lista di tre colonne (venditore, cliente, vendita) che voglio raggruppare per avere per ciascun venditore il numero dei clienti e il numero di vendite. La pivot conta i record per cui il numero dei clienti viene sempre come il numero di vendite. Ho scritto una routine con un ciclo for next e dei cicli do while annidati. L'anomalia che non riesco a eliminare è che quando la routine arriva all'ultimo record non mi scrive il nome del venditore (e secondo me riporta i valori memorizzati nell'ultimo giro). Sono un po' a digiuno di scrittura del codice ma proprio non trovo il problema.
Riepilogando il codice legge le colonna A,B,C dalla riga 2 all'ultima che trova e conta per ogni venditore il numero di clienti e il numero di vendita e a fine ciclo venditore scrive nelle celle G,H,I i valori delle variabili.

Function conta()
Dim x, i, a As Integer
Dim mvenditore, nomecliente As String
Dim mcliente, mveicoli As Integer


Dim Posizione As String
    Dim ultimo_record As Integer
    Range("A1").Select
    
    For i = 1 To 2000
        Posizione = "A" & Trim(Str(i))
        Range(Posizione).Select
        valore_cella = Range(Posizione).Value
        
        If IsEmpty(valore_cella) Then
            ultimo_record = i
            GoTo fine
        End If
    Next

fine:
a = 2

For x = 2 To ultimo_record
   
    mvenditore = Cells(x, 1)
    
    Do While Cells(x, 1) = mvenditore
        nomecliente = Cells(x, 2)
        mcliente = mcliente + 1
        
        Do While Cells(x, 2) = nomecliente
            mveicoli = mveicoli + 1
            x = x + 1
            If x > ultimo_record Then
                Exit Do
            End If
        Loop
        
        
        
        If x > ultimo_record Then
                Exit Do
        End If
        Loop
        
        Cells(a, 7).Value = mvenditore
        Cells(a, 8).Value = mcliente
        Cells(a, 9).Value = mveicoli
        Cells(a, 10).Value = mveicoli / mcliente
        mveicoli = 0
        mcliente = 0
        a = a + 1
   
Next

End Function

di patel data: 23/03/2017 17:57:25
allega un file di esempio per testare la macro
di Luca73 data: 24/03/2017 10:05:34
Non ti salta solo l'ultimo te ne salta altri.
L'errore concettuale è aver usato la stessa variabile in un ciclo for
For x = 2 To ultimo_record
e successivamente in un ciclo (annidato nel ciclo for) While
Do While Cells(x, 2) = nomecliente
x = x + 1
Loop

Pertanto in talune condizioni salta delle righe perche x viene aumentata di 2

Inoltre a me non piace l'impostazione che parta dal fatto che l'ordine sia alfabetico. Provo a buttar giù due righe e poi le posto
Ciao
Luca

di Luca73 data: 24/03/2017 11:02:26
Prova Questa
Ciao
Luca

Sub ContaTL()
Dim Vettore()
Dim Venditore As Range
Dim VenditoreIndex As Long
Dim NuovoVenditore As Boolean
Dim NuovoCliente As Boolean
Dim ClientCellVer As Range
Const NumVend = 1
Const NumCli = 2
Const NumOrd = 3
ReDim Vettore(1 To 3, 1 To 1)
With Sheets("sintesi")
    Vettore(NumVend, 1) = .Range("A2")
    Vettore(NumCli, 1) = 1
    Vettore(NumOrd, 1) = 1
    
    For Each Venditore In .Range(.Range("A3"), .Range("A3").End(xlDown))
        NuovoVenditore = True
        For VenditoreIndex = 1 To UBound(Vettore, 2)
            If Vettore(NumVend, VenditoreIndex) = Venditore Then
                NuovoVenditore = False
                Vettore(NumOrd, VenditoreIndex) = Vettore(NumOrd, VenditoreIndex) + 1
                NuovoCliente = True
                For Each ClientCellVer In .Range(.Range("A2"), Venditore.Offset(-1, 0))
                    If ((ClientCellVer = Venditore) And (ClientCellVer.Offset(0, 1) = Venditore.Offset(0, 1))) Then
                        NuovoCliente = False
                        Exit For
                    End If
                Next ClientCellVer
                If NuovoCliente Then
                    Vettore(NumCli, VenditoreIndex) = Vettore(NumCli, VenditoreIndex) + 1
                    Exit For
                End If
            End If
        Next VenditoreIndex
        If NuovoVenditore Then
            ReDim Preserve Vettore(1 To 3, 1 To UBound(Vettore, 2) + 1)
            Vettore(NumVend, UBound(Vettore, 2)) = Venditore
            Vettore(NumCli, UBound(Vettore, 2)) = 1
            Vettore(NumOrd, UBound(Vettore, 2)) = 1
        End If
    Next Venditore
    For VenditoreIndex = 1 To UBound(Vettore, 2)
         Cells(VenditoreIndex + 1, 7).Value = Vettore(NumVend, VenditoreIndex)
         Cells(VenditoreIndex + 1, 8).Value = Vettore(NumCli, VenditoreIndex)
         Cells(VenditoreIndex + 1, 9).Value = Vettore(NumOrd, VenditoreIndex)
         Cells(VenditoreIndex + 1, 10).Value = Vettore(NumCli, VenditoreIndex) / Vettore(NumOrd, VenditoreIndex)
    Next VenditoreIndex
End With
MsgBox "x"


End Sub

Ciclo do while
di max (utente non iscritto) data: 24/03/2017 11:57:15
Grazie Luca. La routine funziona correttamente ma hai scritto un codice da "professionista"..... Lo userò per studiarci sopra e migliorare la mia conoscenza vba...
di Luca73 data: 24/03/2017 12:59:55
No, qui i professionisti sono altri.
Sono un autodidatta con un pol di esperienza.
Ciao
Luca

Vuoi Approfondire?