Sembrava ok,
ma con alcuni numeri funziona e con altri no.
Moderatori: Anthony47, Flash30005
Quindi comincia da riga 20 verso riga 4 o da riga 20 verso riga 24 (come la macro considera)?Il blocco comincia con il 2
Option Base 0
Public Urs, Vett(30, 11), Vr, ValN, NV As Integer
Sub Trova()
Urs = Worksheets("Foglio1").Range("C" & Rows.Count).End(xlUp).Row
NV = Range("K4").Value
Range("M4:V4").ClearContents
Range("C4:G" & Urs).Interior.ColorIndex = 0 'ClearFormats
ValN = Range("J4").Value
Vr = 0
For I = 0 To 30
For J = 0 To 11
Vett(I, J) = 0
Next J
Next I
Vett(0, 0) = 4 '<<<<<<<<<<< AGG
For RR = 4 To Urs
For CC = 3 To 7
If Cells(RR, CC).Value = ValN Then
Cells(RR, CC).Interior.ColorIndex = 44
Vr = Vr + 1
Vett(Vr, 0) = RR
If NV = Vr Then GoTo salta
End If
Next CC
Next RR
salta:
'Call Trova2
'For I = 0 To Vr
'MsgBox (Vett(I, 0))
'Next I
Call trova3
End Sub
Sub trova3()
FlTre = Application.WorksheetFunction.CountIf(Range("A4:G4"), Range("J4").Value)
J4Vett = ([J4] - 1) Mod 10 + 1
For I = [K4] To 1 Step -1 '<<<<<<<<<<<< MOD
FlDue = 0
For J = Vett(I, 0) - 1 To Vett(I - 1, 0) Step -1
FlUno = 0
For K = 4 To 0 Step -1
For L = 0 To 9
Cells(J, 3 + K).Select
If Cells(J, 3 + K) = Cells(3, 13 + L) And Cells(J, 3 + K) <> [J4] Then
Cells(J, 3 + K).Interior.ColorIndex = 6
FlUno = 1: FlDue = 1
Vett(I, L + 1) = 1
'MsgBox (I & "-" & L + 1)
End If
Next L
Next K
If J = Vett(I - 1, 0) Then
If FlUno > 0 Or FlDue = 0 Then
Vett(I, J4Vett) = 1: End If
End If
If FlUno > 0 Then GoTo NextRng
Next J
NextRng:
Next I
If FlTre = 0 Then Vett(I + 1, J4Vett) = 0
For L = 0 To 9
For I = [K4] To 1 Step -1
Cells(4, 13 + L) = Cells(4, 13 + L) + Vett(I, L + 1)
Next I
Next L
End Sub
Sub trova3()
'Conta tante righe quanto in K5
FlTre = Application.WorksheetFunction.CountIf(Range("A4:G4"), Range("J4").Value)
J4Vett = ([J4] - 1) Mod 10 + 1
For I = [K4] To 1 Step -1
FlDue = 0: FlUno = 0
For J = Vett(I, 0) - 1 To Vett(I - 1, 0) Step -1
' FlUno = 0
For K = 4 To 0 Step -1
For L = 0 To 9
Cells(J, 3 + K).Select
If Cells(J, 3 + K) = Cells(3, 13 + L) And Cells(J, 3 + K) <> [J4] Then
Cells(J, 3 + K).Interior.ColorIndex = 6
FlUno = FlUno + 1: FlDue = 1
Vett(I, L + 1) = Vett(I, L + 1) + 1
'MsgBox (I & "-" & L + 1)
End If
Next L
Next K
If J = Vett(I - 1, 0) Then
If FlUno > 0 Or FlDue = 0 Then
Vett(I, J4Vett) = 1: End If
End If
If FlUno >= [K5] Then GoTo NextRng
Next J
NextRng:
Next I
If FlTre = 0 Then Vett(I + 1, J4Vett) = 0
For L = 0 To 9
For I = [K4] To 1 Step -1
Cells(4, 13 + L) = Cells(4, 13 + L) + Vett(I, L + 1)
Next I
Next L
If [K5] <= 0 Then MsgBox ("Valore K5 (n° di righe) impostato errato; risultati imprecisi")
Range("A1").Select
End Sub
Ciao Anthony,
dopo aver trovato il numero di partenza,successivamente deve trovare N°(2)modificabile anche3) righe con risultati validi,
l'ultima macro da te postata,trova il numero e successivamente trova la prima riga con risultati validi.
Sub trova3()
'Conta tante righe quanto in K5
FlTre = Application.WorksheetFunction.CountIf(Range("A4:G4"), Range("J4").Value)
J4Vett = ([J4] - 1) Mod 10 + 1
For I = [K4] To 1 Step -1
FlDue = 0: FlUno = 0
For J = Vett(I, 0) - 1 To Vett(I - 1, 0) Step -1
FlUnoUno = 0
For K = 4 To 0 Step -1
For L = 0 To 9
Cells(J, 3 + K).Select
If Cells(J, 3 + K) = Cells(3, 13 + L) And Cells(J, 3 + K) <> [J4] Then
Cells(J, 3 + K).Interior.ColorIndex = 6
FlUnoUno = 1: FlDue = 1
Vett(I, L + 1) = Vett(I, L + 1) + 1
'MsgBox (I & "-" & L + 1)
If FlUnoUno > 0 And FlUnoB = 0 Then FlUno = FlUno + 1: FlUnoB = 1
End If
Next L
Next K
FlUnoB = 0
If J = Vett(I - 1, 0) Then
If FlUnoUno > 0 Or FlDue = 0 Then
Vett(I, J4Vett) = 1: End If
End If
If FlUno >= [K5] Then GoTo NextRng
Next J
NextRng:
Next I
If FlTre = 0 Then Vett(I + 1, J4Vett) = 0
For L = 0 To 9
For I = [K4] To 1 Step -1
Cells(4, 13 + L) = Cells(4, 13 + L) + Vett(I, L + 1)
Next I
Next L
If [K5] <= 0 Then MsgBox ("Valore K5 (n° di righe) impostato errato; risultati imprecisi")
Range("A1").Select
End Sub
Sub Trova33()
'Conta per tante righe quanto in K5
FlTre = Application.WorksheetFunction.CountIf(Range("A4:G4"), Range("J4").Value)
J4Vett = ([J4] - 1) Mod 10 + 1
FlDue = 0 ' N° righe con dati
For I = [K4] To 1 Step -1
FlDue = 0
For J = Vett(I, 0) - 1 To 4 Step -1
FlUno = 0
For K = 4 To 0 Step -1
For L = 0 To 9
Cells(J, 3 + K).Select
If Cells(J, 3 + K) = Cells(3, 13 + L) Then
Cells(J, 3 + K).Interior.ColorIndex = 6
FlUno = 1 ': FlDue = 1
Vett(I, L + 1) = Vett(I, L + 1) + 1
End If
Next L
Next K
If FlUno > 0 Then FlDue = FlDue + 1
If FlDue >= [K5] Then GoTo NextRng
Next J
NextRng:
Next I
If FlTre = 0 Then Vett(I + 1, J4Vett) = 0
For L = 0 To 9
For I = [K4] To 1 Step -1
Cells(4, 13 + L) = Cells(4, 13 + L) + Vett(I, L + 1)
Next I
Next L
If [K5] <= 0 Then MsgBox ("Valore K5 (n° di righe) impostato errato; risultati imprecisi")
Range("A1").Select
End Sub
Range("M4:V4").ClearContents
Range("C4:G" & Urs).Interior.ColorIndex = 0 'ClearFormats
Torna a Applicazioni Office Windows
cerca il più grande numero di celle vuote in un intervallo Autore: papiriof |
Forum: Applicazioni Office Windows Risposte: 2 |
Conta.più.se con solo parte del testo Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 9 |
Excel: formula automatica per evidenziare prodotto scaduto Autore: gamma_ray |
Forum: Applicazioni Office Windows Risposte: 3 |
Salvare file excel in formato html escludendo le immagini Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 10 |
Automatizzare numero settimane nel mese di un anno Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 3 |
Visitano il forum: Nessuno e 99 ospiti