Ma se le estrazioni sono capovolte
perché mi evidenzi il "12" della riga 4 e non quello che sta in fondo alle righe (dalla 4000ª riga in sù)?
Moderatori: Anthony47, Flash30005
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
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()
J4Vett = ([J4] - 1) Mod 10 + 1
For I = [K4] To 2 Step -1
For J = Vett(I, 0) - 1 To Vett(I - 1, 0) Step -1
For K = 4 To 0 Step -1
FlUno = 0
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
Vett(I, L + 1) = 1
'MsgBox (I & "-" & L + 1)
End If
Next L
Next K
'I = 4
If FlUno > 0 Then
Vett(I, J4Vett) = 1: End If
Next J
Next I
For L = 0 To 9
For I = [K4] To 2 Step -1
Cells(4, 13 + L) = Cells(4, 13 + L) + Vett(I, L + 1)
Next I
Next L
End Sub
=INT((J4-1)/10)*10+1
=M3+1
Sub trova3()
J4Vett = ([J4] - 1) Mod 10 + 1
For I = [K4] To 2 Step -1
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
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 Then
Vett(I, J4Vett) = 1: End If
End If
If FlUno > 0 Then GoTo NextRng
Next J
NextRng:
Next I
For L = 0 To 9
For I = [K4] To 2 Step -1
Cells(4, 13 + L) = Cells(4, 13 + L) + Vett(I, L + 1)
Next I
Next L
End Sub
Sub trova3()
J4Vett = ([J4] - 1) Mod 10 + 1
For I = [K4] To 2 Step -1
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
For L = 0 To 9
For I = [K4] To 2 Step -1
Cells(4, 13 + L) = Cells(4, 13 + L) + Vett(I, L + 1)
Next I
Next L
End Sub
Sub Trova_Estratto1()
J4Vett = ([J4] - 1) Mod 10 + 1
For I = [K4] To [color=#FF0000]1 [/color]Step -1
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 110 ospiti