ho una macro che mi conta quante volte si ripete lo stesso importo nella colonna H del fgl 1 e lo scrive in fgl 2 col BZ.
la macro non mi da errore, funzionava correttamente fino a quando nelle celle di col H non c'erano formule
e gli importi li scrivevo manualmente.
ora nelle celle di col H fgl 1 ho inserito delle formule.
ebbene la macro mi conta anche le celle "vuote" cioe' con nessun importo calcolato cioe--> ""
e mi riporta questo valore in fgl2 col bz.
io vorrei che la macro mi conti e riporti, solo le celle contenenti un importo ....!
questa la macro in questione (che si trova nel modulo 1):
- Codice: Seleziona tutto
Sub analizzaimporti()
Sheets("2-statistiche").Select
UserForm2.Show vbModeless
DoEvents
Inizio = Timer
ActiveSheet.Unprotect
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim H As Integer: Dim J As Integer: Dim R As Integer
Application.ScreenUpdating = False
Application.Calculation = xlManual
Set Ws1 = Sheets("1-gol-Fogl.Base")
Set Ws2 = Sheets("2-statistiche")
UR = Ws1.Range("H" & Rows.Count).End(xlUp).Row
UR2 = Ws2.Range("BY" & Rows.Count).End(xlUp).Row
Ws2.Range("BY9:CB" & UR2).ClearContents
For H = 9 To UR
UR2 = Ws2.Range("BY" & Rows.Count).End(xlUp).Row + 1
If UR2 < 9 Then UR2 = 9
For J = 9 To UR2
If Ws2.Cells(J, 77) = Ws1.Cells(H, 8) Then
Ws2.Cells(J, 78).Value = Ws2.Cells(J, 78).Value + 1
GoTo saltaH
Else
If Ws2.Cells(J, 77).Value = 0 Then
Ws2.Cells(J, 77) = Ws1.Cells(H, 8)
Ws2.Cells(J, 78).Value = 1
End If
End If
Next J
saltaH:
Next H
UR2 = Ws2.Range("BY" & Rows.Count).End(xlUp).Row
For J = 9 To UR2
ContaV = 0
ContaP = 0
Q = Ws2.Range("BY" & J)
For H = 8 To UR
If Q = Ws1.Cells(H, 8) Then
If UCase(Ws1.Cells(H, 13)) = "V" Then ContaV = ContaV + 1
If UCase(Ws1.Cells(H, 13)) = "P" Then ContaP = ContaP + 1
End If
Next H
Ws2.Range("CA" & J) = ContaV
Ws2.Range("CB" & J) = ContaP
Next J
Sheets("2-statistiche").Select
Range("BY9:CB100").Select
Selection.Sort Key1:=Range("BY9"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
ActiveWindow.ScrollRow = 1 ' alza la barra later dx
ActiveWindow.DisplayGridlines = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, AllowFormattingRows:=True
Range("CC2").Select
Unload UserForm2
Fine = Timer
MsgBox ("Tempo impiegato " & Int((Fine - Inizio) / 60) & " min " & (Fine - Inizio) Mod 60 & " Sec")
End Sub
vi allego anche il file
https://rapidshare.com/files/1907575183/gol.rar
grazie ciao