[Risolto] Macro non funzionante

[patel]

forse ho trovato il modo, prova così

Codice: Seleziona tutto

Option VBASupport 1

Dim importo(1 To 1000) As Double, quantita(1 To 1000) As Double, nummax As Integer, numaart As Integer, somma As Double
 
 
 Sub estraisomma()
    CompatibilityMode(True)
    nummax = Cells(1, 19)
    numart = Cells(2, 19)
    For i = 1 To numart
         quantita(i) = 0
         importo(i) = 0
    Next i
   i = 1
    While i <= nummax
        If (Cells(i, 2).Value <> 0 And Cells(i, 2) <> "") Then
            j = Cells(i, 2)
        End If
        If (Cells(i, 12).Value <> 0 And Cells(i, 14).Value <> 0 And Cells(i, 14) <> "") Then
                importo(j) = importo(j) + Cells(i, 16)
                quantita(j) = quantita(j) + Cells(i, 12)
         End If
        i = i + 1
    Wend
        For i = 1 To numart
        Cells(i, 20) = i
        Cells(i, 21) = quantita(i)
        Cells(i, 22) = Worksheets("Elenco prezzi").Cells(11 + i * 3 - 2, 6)
        Cells(i, 23) = Cells(i, 21) * Cells(i, 22)
        Cells(i, 24) = importo(i)
        If Abs(Cells(i, 24) - Cells(i, 23)) > 1000 Then
                    Cells(i, 20).Select
                    Beep
                    MsgBox ("Errore")
        End If

    Next i

End Sub
 
Sub controllasomme()
     CompatibilityMode(True)
     nummax = Cells(1, 19)
     numart = Cells(2, 19)
          somma = 0
          j = 0
    i = 1
     While i <= nummax
         If (Cells(i, 2).Value <> 0 And Cells(i, 2) <> "") Then
             somma = 0
         End If
        
         If (Cells(i, 4) = "") And ((Cells(i, 6) = "") And (Cells(i, 8) = "") And (Cells(i, 10) = "") And (Cells(i, 12).Value <> 0 And Cells(i, 12) <> "")) Then
                 Cells(i, 19) = somma
                 If  val(Cells(i, 12)) <> 0 then
                   If (Abs(somma - Cells(i, 12)) > 0.005) And (somma <> 0) Then
                     Cells(i, 12).Select
                     Beep
                     MsgBox ("Errore di somma")
                   End If
                 End If
                 
         End If
         If (Cells(i, 12).Value <> 0 And Cells(i, 12) <> "") Then
                  If  val(Cells(i, 12)) <> 0 then somma = somma + Cells(i, 12)
                 Cells(i, 12).Select
         End If
         
         i = i + 1
         j = j + 1
     Wend
 End Sub 
 
 Sub controllaprodotti()
     CompatibilityMode(True)
     nummax = Cells(1, 19)
     numart = Cells(2, 19)
    i = 1
     While i <= nummax
         prodotto = 0
         If (Cells(i, 12).Value <> 0 And (Cells(i, 12) <> "")) Then
             If (((Cells(i, 4).Value <> 0 Or (Cells(i, 4) = ""))) And ((Cells(i, 6) <> 0 Or (Cells(i, 6) = ""))) And ((Cells(i, 8).Value <>0 Or (Cells(i, 8) = "")) And (Cells(i, 10).Value <> 0 Or (Cells(i, 10) = "")))) Then
                 Cells(i, 12).Select
                 If Cells(i, 4) <> "" Then a = Cells(i, 4) Else a = 1
                 If Cells(i, 6) <> "" Then b = Cells(i, 6) Else b = 1
                 If Cells(i, 8) <> "" Then c = Cells(i, 8) Else c = 1
                 If Cells(i, 10) <> "" Then d = Cells(i, 10) Else d = 1
                 prodotto = a * b * c * d
                 If  val(Cells(i, 12)) <> 0 then
                   If (Abs(prodotto - Cells(i, 12)) > 0.005) And ((Cells(i, 4) <> "") Or (Cells(i, 6) <> "") Or (Cells(i, 8) <> "") Or (Cells(i, 10) <> "")) Then
                     Cells(i, 12).Select
                     Cells(i, 18) = prodotto
                     Beep
                     MsgBox ("Errore di prodotto")
                   End If
                 End If
             End If
         End If
         i = i + 1
     Wend
 End Sub

[theirish]

Sei un grande, funziona tutto perfettamente. Ho solo aggiunto un .Value alla fine della riga 28 perchè la macro "estraisomma" non generava i risultati nella colonna V. In qualche modo dovrò sdebitarmi. Grazie.

[patel]

.Value dovrebbe essere aggiunto ovunque ci sia cells, Excel non ci fa caso ma Libre distingue Value da String e può quindi fare confusione