Ciao a tutti,
anche se non posto da molto,sono sempre presente e vi leggo tutti i giorni.
Ho un piccolo problema dovrei evidenziare gli ambi e terni isotopi (stessa posizione)di una estrazione,
con la formattazione condizionale.allego foto esempio
Moderatori: Anthony47, Flash30005
Sub ColIsotopi()
Dim Vettore1(5) As String
Dim Vettore2(5) As String
Dim CColo(5) As String
For Rc = 1 To 10
For Rc2 = Rc + 1 To 11
conta = 0
For C = 2 To 6
Vettore1(C - 1) = Cells(Rc, C).Value
Vettore2(C - 1) = Cells(Rc2, C).Value
If Vettore1(C - 1) = Vettore2(C - 1) Then
conta = conta + 1
CColo(conta) = C
Col = (Vettore1(4) / 50 - Int(Vettore1(4) / 50)) * 50
End If
Next C
If conta > 1 Then
If Col = 1 Or Col = 2 Or Col = 5 Or Col = 9 Or Col = 10 Or Col = 11 Or Col = 21 Or Col = 25 Or Col = 30 Or Col = 31 Or Col = 32 Or Col = 49 Then Col = Col + 2
For FC = 1 To conta
Cells(Rc, Val(CColo(FC))).Interior.ColorIndex = Col
Cells(Rc2, Val(CColo(FC))).Interior.ColorIndex = Col
Next FC
End If
Next Rc2
Next Rc
End Sub
Col = Int(((Vettore1(1) + Vettore1(2)) / 50 - Int((Vettore1(1) + Vettore1(2)) / 50)) * 50) + 1
Sub ColIsotopi()
Dim Vettore1(5) As String
Dim Vettore2(5) As String
Dim CColo(5) As String
For Rc = 1 To 10
For Rc2 = Rc + 1 To 11
conta = 0
For C = 2 To 6
Vettore1(C - 1) = Cells(Rc, C).Value
Vettore2(C - 1) = Cells(Rc2, C).Value
If Vettore1(C - 1) = Vettore2(C - 1) Then
conta = conta + 1
CColo(conta) = C
Col = Int(((Vettore1(1) + Vettore1(2)) / 50 - Int((Vettore1(1) + Vettore1(2)) / 50)) * 50) + 1
End If
Next C
If conta > 1 Then
If Col = 1 Or Col = 2 Or Col = 5 Or Col = 9 Or Col = 10 Or Col = 11 Or Col = 21 Or Col = 25 Or Col = 30 Or Col = 31 Or Col = 32 Or Col = 49 Then Col = Col + 2
For FC = 1 To conta
Cells(Rc, Val(CColo(FC))).Interior.ColorIndex = Col
Cells(Rc2, Val(CColo(FC))).Interior.ColorIndex = Col
Next FC
End If
Next Rc2
Next Rc
End Sub
Sub ColIsotopi()
Dim Vettore1(5) As String
Dim Vettore2(5) As String
Dim CColo(5) As String
For Rc = 1 To 99
For Rc2 = Rc + 1 To 100
conta = 0
For C = 2 To 11
Vettore1(C - 1) = Cells(Rc, C).Value
Vettore2(C - 1) = Cells(Rc2, C).Value
If Vettore1(C - 1) = Vettore2(C - 1) Then
conta = conta + 1
CColo(conta) = C
Col = Int(((Vettore1(1) + Vettore1(2)) / 50 - Int((Vettore1(1) + Vettore1(2)) / 50)) * 50) + 1
End If
Next C
If conta > 1 Then
If Col = 1 Or Col = 2 Or Col = 5 Or Col = 9 Or Col = 10 Or Col = 11 Or Col = 21 Or Col = 25 Or Col = 30 Or Col = 31 Or Col = 32 Or Col = 49 Then Col = Col + 2
For FC = 1 To conta
Cells(Rc, Val(CColo(FC))).Interior.ColorIndex = Col
Cells(Rc2, Val(CColo(FC))).Interior.ColorIndex = Col
Next FC
End If
Next Rc2
Next Rc
End Sub
Dim Vettore1(5) As String
Dim Vettore2(5) As String
Dim CColo(5) As String
Dim Vettore1(10) As String
Dim Vettore2(10) As String
Dim CColo(10) As String
1 4 5 10 14 15 16 17 18 20
2 5 6 9 10 11 14 15 17 18
1 4 8 9 10 11 16 17 19 20
4 6 7 8 11 12 13 15 19 20
2 3 5 6 7 10 13 16 17 19
2 6 8 11 12 13 14 16 17 19
9 10 12 13 14 15 16 17 19 20
7 8 9 10 12 13 14 16 17 19
3 7 8 9 12 14 16 17 18 19
1 2 3 4 5 6 8 9 16 17
1 2 5 6 7 10 13 15 17 19
1 2 5 9 10 13 16 17 18 19
1 3 5 6 7 11 14 15 18 19
3 4 7 9 10 12 13 15 16 17
2 6 7 8 9 10 11 15 16 19
1 4 5 6 7 11 12 13 16 19
2 4 7 8 9 12 15 16 17 20
2 3 4 5 7 8 9 10 16 20
4 6 7 9 11 12 13 14 16 20
2 4 6 7 11 12 14 17 18 20
1 3 4 6 10 12 14 16 17 20
1 3 5 7 10 11 12 14 16 18
3 5 7 10 11 15 16 17 18 20
2 5 6 7 10 11 13 16 17 19
2 3 5 7 8 9 10 12 15 20
2 4 5 6 7 11 13 14 18 19
1 4 5 7 8 9 10 18 19 20
3 4 5 6 8 10 14 15 16 19
1 3 4 5 6 8 9 12 15 20
1 2 8 10 11 13 15 16 17 18
1 2 3 4 8 9 10 11 14 20
2 7 8 10 12 14 16 18 19 20
1 2 3 6 11 14 16 18 19 20
1 2 6 8 11 12 14 16 18 20
2 4 5 6 7 12 14 15 17 18
1 2 3 7 8 11 13 15 16 17
1 2 3 5 6 10 11 18 19 20
1 3 6 9 10 11 15 16 19 20
2 3 7 8 10 11 13 14 15 16
1 3 5 10 11 13 14 15 16 19
2 3 4 6 8 9 14 16 18 20
2 3 5 6 8 10 11 15 19 20
3 5 6 8 11 12 13 14 16 17
5 6 7 9 10 13 14 15 16 18
3 4 7 8 10 11 12 14 15 17
2 4 5 6 7 10 12 17 18 19
1 5 7 8 10 11 14 15 18 19
1 5 6 9 11 14 15 17 18 20
6 8 10 12 13 14 15 16 19 20
2 4 6 7 9 11 13 14 15 16
4 5 6 7 8 10 11 17 18 19
2 4 6 8 10 11 12 17 19 20
1 4 5 6 7 9 10 11 12 15
2 3 4 8 9 12 13 14 15 19
1 4 5 6 7 9 10 12 16 19
4 6 8 10 12 13 14 15 16 20
2 4 8 9 12 14 15 17 18 20
1 3 5 7 10 11 12 16 17 20
2 3 6 7 10 11 14 15 16 19
1 2 3 4 9 11 14 16 18 20
1 2 6 7 9 10 12 13 17 18
1 7 10 11 13 15 16 17 18 20
1 2 3 8 9 14 15 16 19 20
2 4 7 11 13 15 16 17 18 19
1 2 4 9 10 11 14 16 17 19
1 3 4 7 9 11 14 16 17 19
3 4 7 11 12 14 15 16 17 18
1 4 7 8 10 12 14 16 18 20
2 3 4 8 9 10 11 12 17 20
2 3 5 8 9 10 11 12 16 20
1 2 3 8 10 13 14 15 16 19
3 6 7 8 9 10 11 13 16 20
2 3 6 7 11 12 14 17 18 20
1 2 6 7 9 11 14 15 17 19
1 3 10 11 12 13 15 16 19 20
1 2 3 7 8 13 14 15 18 20
2 3 6 10 11 12 14 17 19 20
1 4 6 9 10 13 14 15 16 19
1 4 5 7 11 12 13 17 19 20
1 2 3 4 8 12 13 15 16 17
1 3 6 7 8 11 13 15 16 20
1 2 5 6 13 14 15 16 18 20
3 5 6 7 8 10 12 13 14 17
2 4 6 8 11 13 14 16 18 20
1 2 3 6 8 11 15 17 18 20
1 5 6 9 11 13 14 15 18 19
5 6 8 10 11 12 13 15 16 20
2 3 5 6 8 9 10 17 18 19
2 4 6 7 10 12 14 15 16 17
3 4 7 9 10 12 13 15 16 19
1 2 3 5 6 12 13 15 16 17
3 4 5 6 7 10 17 18 19 20
1 2 3 5 7 10 16 17 19 20
1 9 10 11 2 13 15 16 17 20
3 4 6 10 11 14 16 17 18 20
1 2 4 7 8 9 11 14 16 18
5 7 8 9 10 13 14 17 18 20
3 4 6 9 12 15 16 17 18 19
2 6 7 8 9 13 14 15 16 19
Torna a Applicazioni Office Windows
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 |
formula excel non visualizza risultato Autore: tommasog |
Forum: Applicazioni Office Windows Risposte: 6 |
Excel 2016 - Funzione SCARTO + INDIRETTO Autore: pl1957 |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Nessuno e 10 ospiti