Moderatori: Anthony47, Flash30005
Sei stanco di vincere o guadagnare?
Sub ContaP()
Dim Ws1 As Worksheet
Set Ws1 = Sheets("Archivio")
Dim VN(10) As Integer
URA = Ws1.Range("C" & Rows.Count).End(xlUp).Row
Ws1.Range("S6:S" & URA).ClearContents
For CCN = 6 To 15
VN(CCN - 5) = Ws1.Cells(2, CCN).Value
Next CCN
For RRA = 6 To URA
For CCA = 6 To 15
NA = Ws1.Cells(RRA, CCA).Value
For S = 1 To 10
If NA > VN(S) Then GoTo SaltaS
If NA = VN(S) Then
Ws1.Range("S" & RRA).Value = Ws1.Range("S" & RRA).Value + 1
GoTo SaltaCCA
End If
SaltaS:
Next S
SaltaCCA:
Next CCA
Next RRA
End Sub
in col S come dicevo prima , vorre riportare quanti numeri ho -indovinato - tra quelli scritti in F2:O2
senza analizzare il num scritto in col Q ma solo i num che sono in colonna F:O
raimea ha scritto:ottimo tutto ok![]()
esatto il numerone non va considerato,in col S come dicevo prima , vorre riportare quanti numeri ho -indovinato - tra quelli scritti in F2:O2
senza analizzare il num scritto in col Q ma solo i num che sono in colonna F:O
azz e' vero ho scritto 4 ok mentre in relta' erano 5....
mea culpa..![]()
grazie
Flash30005 ha scritto:Ecco! Si!
Bravo Ahidai!
Quello è il software giusto, lo usano in molti
ed evito di creare macro di "analisi" per Raimea![]()
Ciao
Sub ContaP()
Dim Ws1 As Worksheet
Set Ws1 = Sheets("Archivio")
Dim VN(10) As Integer
URA = Ws1.Range("C" & Rows.Count).End(xlUp).Row
Ws1.Range("S6:S" & URA).ClearContents
For CCN = 6 To 15
VN(CCN - 5) = Ws1.Cells(2, CCN).Value
Next CCN
For RRA = 6 To URA
For CCA = 6 To 15
NA = Ws1.Cells(RRA, CCA).Value
For S = 1 To 10
If NA > VN(S) Then GoTo SaltaS
If NA = VN(S) Then
Ws1.Range("S" & RRA).Value = Ws1.Range("S" & RRA).Value + 1
GoTo SaltaCCA
End If
SaltaS:
Next S
SaltaCCA:
Next CCA
Next RRA
End Sub
URA = Ws1.Range("C" & Rows.Count).End(xlUp).Row '<<<<< esistente lasciare così
Ws1.Range("S6:S" & URA).ClearContents '<<<<<<<<<<<<<<<<<<<esistente da modificare o sostituire
Ws1.Range("S6:S" & URA).Value = 0
Sub contrl12_5min()
userform1.Show vbModeless
DoEvents
INIZIO = Timer
Worksheets("archivio12_5min").Unprotect ' togli protez
Range("S6:S60000").Select
Selection.ClearContents
Dim Ws1 As Worksheet
Set Ws1 = Sheets("Archivio12_5min")
Dim VN(10) As Integer
URA = Ws1.Range("C" & Rows.Count).End(xlUp).Row
Ws1.Range("S6:S" & URA).Value = 0
For CCN = 6 To 15
VN(CCN - 5) = Ws1.Cells(2, CCN).Value
Next CCN
For RRA = 6 To URA
For CCA = 6 To 15
NA = Ws1.Cells(RRA, CCA).Value
For S = 1 To 10
If NA > VN(S) Then GoTo SaltaS
If NA = VN(S) Then
Ws1.Range("S" & RRA).Value = Ws1.Range("S" & RRA).Value + 1
GoTo SaltaCCA
End If
SaltaS:
Next S
SaltaCCA:
Next CCA
Next RRA
'------------------------------------------------------------------
Range("Z7:AA26").Select ' ordino dal piu frequente
Selection.Copy
Range("Z29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("AA29"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("X13").Select
'---------------------------------------------------
Dim c, numero, cl ' coloro di giallo i numeri
Worksheets("archivio12_5min").Range("f6:o60000").Interior.ColorIndex = xlNone ' mette tutto bianco
Range("b150:d60000").Interior.ColorIndex = 2 '<<< qui colora una riga
For RR = 150 To 60000 Step 204
Range("b" & RR & ":d" & RR).Interior.ColorIndex = 8
Next RR
Range("f150:o60000").Interior.ColorIndex = 2 '<<< qui colora una riga
For RR = 150 To 60000 Step 204
Range("f" & RR & ":o" & RR).Interior.ColorIndex = 8
Next RR
For c = 6 To 15 ' cerca e colora di giallo
numero = Cells(2, c).Value
For Each cl In Range("F6:O6000")
If cl <> "" And cl = numero Then
cl.Interior.Color = 65535 '--> giallo
End If
Next cl
Next c
'-----------------------------------------------------------
Columns("Y:Y").ColumnWidth = 5
'-----------------------------------------------------------
Sheets("info").Select ' blocco fgl info
ActiveWindow.DisplayGridlines = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, AllowFormattingRows:=True
Sheets("archivio12_5min").Select
Range("A1").Select
'----------------------------------------------------------
ActiveWindow.DisplayGridlines = False 'metti protez e nascondi griglia
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, AllowFormattingRows:=True
Unload userform1
Fine = Timer
MsgBox ("Tempo impiegato " & Int((Fine - INIZIO) / 60) & " min " & (Fine - INIZIO) Mod 60 & " Sec")
End Sub
oldStatusBar = Application.DisplayStatusBar 'serve x vedere barra avnz % totali sono 5 righe
Application.DisplayStatusBar = True 'serve x vedere barra avnz %
For J = 5 To 5000 '<------- INIZIO E FINE DELLE RIGHE DA CONTROLLARE ma in realta' in A2 ce' il num di righe reali da verificare
Percent = J / 5000 'serve x vedere barra avnz %
Application.StatusBar = "celle controllate gia contate " & Format(Percent, "0%") & " --> By Raimea - www.lelugarine.eu - info@lelugarine.eu" 'serve x vedere barra avnz %
Somma = 0
For Each Cella In Range("o" & J & ":t" & J)
If Cella.Interior.ColorIndex = 3 Then '3 e' il cod colore rosso '<<< in questo caso questo passaggio non serve colorare nulla
Somma = Somma + 1
End If
Next
ActiveSheet.Cells(J, "CA") = Somma
Next J
Application.DisplayStatusBar = oldStatusBar 'serve x vedere barra avnz %
Application.DisplayStatusBar = False 'serve x vedere barra avnz %
For RRA = 6 To URA '<<<ESISTENTE
Percent = RRA / Range("A2").Value '***
Application.StatusBar = "celle controllate gia contate " & Format(Percent, "0%") & " --> By Raimea - www.lelugarine.eu - info@lelugarine.eu" '***
Sub contrl12_5min()
oldStatusBar = Application.DisplayStatusBar '***
Application.DisplayStatusBar = oldStatusBar '***
Application.StatusBar = False '***
End Sub
'in testa
Application.Calculation = xlManual
Application.ScreenUpdating = False
'in coda
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.Calculation = xlManual
Application.ScreenUpdating = False
questo host che non raccomando...
raimea ha scritto:con questo file si puo rendere conto di chi realmente, ci guadagna....
Torna a Applicazioni Office Windows
Visitano il forum: Nessuno e 10 ospiti