Moderatori: Anthony47, Flash30005
Personalmente non ho capito i termini del problema.I dati ricavati andrebbero scritti nel foglio dettagli in colonna N e in M dello stesso
rigo e a seguire è indicato quanti ce ne sono mentre in rigo 1 è indicato il numero
da prendere in considerazione.
Preciso che i dati da ottenere riguardano la colonna singola e non l'insieme delle colonne.
Sub myPasso()
Dim ResArr(1 To 5000, 1 To 9), myArr, ResBase As Range, myArea As Range, myH As Long
Dim I As Long, J As Long, mySVal As Long, jMax As Long
'
'mytim = Timer
Set ResBase = Sheets("Dettagli").Range("N2") '<<< L' inizio dell' area risultati
Set myRange = Sheets("Cifre").Range("C10:C10000") '<<< L' are dei dati da analizzare
'
Set myArea = Application.Intersect(Sheets(myRange.Parent.Name).UsedRange, myRange)
myArr = myArea.Value
myH = myArea.Rows.Count
For I = 1 To myH - 1
If myArr(I, 1) > 0 Then
mySVal = myArr(I, 1)
J = 1
Do
If myArr(I + J, 1) = mySVal Then
If J > jMax Then jMax = J: Debug.Print jMax & " - " & mySVal
ResArr(J, mySVal) = ResArr(J, mySVal) + 1
Exit Do
End If
J = J + 1
If (I + J) > myH Then Exit Do
DoEvents
Loop
End If
Next I
ResBase.Resize(jMax, 9).Value = ResArr
'MsgBox (Timer - mytim)
End Sub
giorgioa oggi ha scritto:Non volevo considerare il 10 che come il 9 e in parte il numero 8 sono ininfluenti ai fini della statistica e poi volevo che la macro si fermasse a rigo 30
giorgioa ieri ha scritto:in tutta la colonna ci sono solo i numeri da 0 a 9
Sub myPassoAll()
Dim ResArr(), myArr, ResBase As Range, myArea As Range, myH As Long
Dim I As Long, J As Long, mySVal As Long, jMax As Long, JJ As Long, Dels As Long
'
mytim = Timer
Set ResBase = Sheets("Dettagli").Range("N2") '<<< L' inizio dell' area risultati
Set myRange = Sheets("Cifre").Range("C10:C10000") '<<< L' are dei dati da analizzare
Dels = 30 '<<< Il numero ei risultati da visualizzare
'
ReDim ResArr(1 To Dels + 10, 1 To 9)
For JJ = 0 To 7
Set myArea = Application.Intersect(Sheets(myRange.Parent.Name).UsedRange, myRange.Offset(0, JJ))
myArr = myArea.Value
myH = myArea.Rows.Count
For I = 1 To myH - 1
If myArr(I, 1) > 0 And myArr(I, 1) < 9 Then
mySVal = myArr(I, 1)
J = 1
Do
If myArr(I + J, 1) = mySVal Then
If J > jMax Then jMax = J ': Debug.Print jMax & " - " & mySVal
ResArr(J, mySVal) = ResArr(J, mySVal) + 1
Exit Do
End If
J = J + 1
If J > (Dels + 10) Then Exit Do
If (I + J) > myH Then Exit Do
DoEvents
Loop
End If
Next I
ResBase.Offset(0, 11 * JJ).Resize(Dels * 2, 9).ClearContents
ResBase.Offset(0, 11 * JJ).Resize(Dels, 9).Value = ResArr
Next JJ
MsgBox (Timer - mytim)
End Sub
Erase ResArr '<<< AGGIUNGERE
For I = 1 To myH - 1 '<<< esistente
ReDim ResArr(1 To Dels + 10, 1 To 9) '<<< AGGIUNGERE QUESTA invece della Erase
For I = 1 To myH - 1 '<<< Esistente
Torna a Applicazioni Office Windows
Disattivazione funzione " Telemetria " in W 10 Autore: mastino46 |
Forum: Software Windows Risposte: 5 |
COME RICONOSCERE UNA APP "POTENZIALMENTE DANNOSA" SU W11 Autore: franco11 |
Forum: Sistemi Operativi Windows Risposte: 3 |
"Spegnere" il riconoscimento data. Autore: aggittoriu |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Nessuno e 70 ospiti