[VB6] Determinare valori ripetuti in un gruppo

[Magicolotto]

ok

text3 e una matrice di cntrollo che va da 0 a 9

devo vedere se ci sono numeri ripetuti, se è cosi' devo colorare la cella text3 di giallo

[alka]

Originariamente inviato da Magicolotto
ciao ragazzi
domandas semplicissima

Per favore, il linguaggio nella discussione, come da Regolamento.

Il linguaggio viene riportato per consentire a chi risponde di sapere - per quanto possibile - prima se è realmente in grado di farlo, perciò anche se nella tua firma dichiari che tutti i tuoi post sono riferiti a VB6, lo devi scrivere anche nel titolo, se non altro perchè io non voglio inseguire tutti i tuoi post e cambiare il titolo come ho fatto con questo: se tutti facessero così, e siamo vicini, io e Johnny saremmo già periti.

Ciao!

[LMondi]

Se hai una matrice di controlli (nell'esempio Text1) di n componenti e vuoi verificare l'eventuale ripetizione dei numeri, potresti utilizzare questa routine (ho sostituito il giallo con il rosso, altrimenti non si vedeva):

Private Sub Command1_Click()
    Dim vrNum As Variant
    Dim y As Integer
    Dim lgWhere As Long
    Dim count As Integer
    
    For y = Form1.Text1.LBound To Form1.Text1.UBound Step 1
         count = 0
         vrNum = Form1.Text1(y).Text
        For Each vrNum In Form1.Text1()
            lgWhere = StrComp(Form1.Text1(y).Text, vrNum, 0)
            If lgWhere = 0 And count > y Then
                vrNum.ForeColor = vbRed
            End If
            count = count + 1
        Next vrNum
    Next y

End Sub

Se funziona, magari mi suggerisci un ambo!

[Magicolotto]

grazie Lmondi

il mio form è : archivio.frm
il text3 va da 0 a 9

io lo modificato cosi :

Dim vrNum As Variant
    Dim y As Integer
    Dim lgWhere As Long
    Dim count As Integer
    
    For y = archivio.Text3.LBound To archivio.Text3.UBound Step 1
         count = 0
         vrNum = archivio.Text3(y).Text
        For Each vrNum In archivio.Text3()
            lgWhere = StrComp(archivio.Text3(y).Text, vrNum, 0)
            If lgWhere = 0 And count > y Then
                vrNum.ForeColor = vbred
            End If
            count = count + 1
        Next vrNum
    Next y

pero evidenzia i text3() tutto dello stesso colore cioè rosso
tranne che il 1 ° valore Text3(0) che resta nero


n.b.:
ecco la tua richiesta
genova milano torino venezia
15-20

moderazione

[LMondi]

Ho riproposto l'esempio con i tuoi Nomi, ... funziona.
Allora devi controllare gli Indici (Index) della matrice Text3 che siano susseguenti da 0 a 9 (click su ciascun controllo di Nome Text3 e controllo che la proprietà Index sia susseguente 0,1, ... 9)

[Magicolotto]

ho modificato cosi

Dim vrNum As Variant
    Dim y As Integer
    Dim lgWhere As Long
    Dim count As Integer
    
    For y = 0 To 9 Step 1
         count = 0
         vrNum = Text3(y).Text
        For Each vrNum In Text3()
            lgWhere = StrComp(Text3(y).Text, vrNum, 9)
            If lgWhere = 0 And count > y Then
              '  vrNum.BackColor = vbRed
                Text3(y).BackColor = vbRed
                vrNum.BackColor = vbRed  ' ho agginto quest'altra riga xchè mi evidenziava solo l'ultimo valore invece con questa ne evidenzia due 
           End If
            count = count + 1
        Next vrNum
    Next y

adesso quando cambio valori di text3()

restanno evidenziati i text3().text in rosso precedentemete trovati

dovrei far si di ristabilire il tutto come se fosse la 1° volta

[Magicolotto]

grazie risolto

[LMondi]

Ciao Magicolotto.
Ho visto il tuo post e mi sembra che ci sia un errore di digitazione;
mi riferisco a StrComp(Text3(y).Text, vrNum, 9 )
i valori consentiti dalla funzione StrComp per il tipo di confronto, nel caso in esame, sono -1, 0, 1. Avevo scelto il parametro 0 per effettuare un confronto binario. Quindi fai pure le tue scelte ma cambia il 9, altrimenti potrebbe dare dei fastidi.
Poi perchè non usi "For y = Form1.Text1.LBound To Form1.Text1.UBound Step 1" se hai impostato una matrice di controlli? LBound ti restituisce il limite inferiore della matrice (0) ed UBound il limite superiore (9), rendendo il tutto dinamico qualunque sia il numero dei componenti della matrice e non statico come "For y = 0 To 9 Step 1".
Per quanto riguarda la necessità di marcare anche il numero di paragone, cioè il primo, pensavo che fossi necessario evidenziare solo i numeri ripetuti (in altri termini il secondo, terzo, ...)comunque non anche il primo in sequenza da sinistra verso destra. Ti assicuro che questa necessità mi ha procurato non pochi fastidi nella realizzazione della routine.
In fine per ripristinare il colore bianco di sfondo delle celle puoi usare:

Private Sub Command2_Click()
    Dim i As Integer
    
    For i = Form1.Text1.LBound To Form1.Text1.UBound
        If Form1.Text1(i).BackColor <> vbWhite Then
            Form1.Text1(i).BackColor = vbWhite
        End If
    Next i

End Sub

In ogni caso, ti auguro un buon lavoro!

[Magicolotto]

ok

ho fatto cosi :

     Dim i As Integer
    Dim j As Integer
    Dim n(1 To 50) As Integer
    Dim sm(1 To 10) As Integer
    Dim y As Integer
    Dim lgWhere As Long
    Dim count As Integer
     Dim vrNum As Variant


    For i = 1 To 50
        n(i) = adoPrimaryRS(i)
    Next i
    
    ' DISTANZE
    kb = 1
    For i = 1 To 49
        For j = i + 1 To 50
            sm(kb) = Abs(n(i) + n(j))
            If sm(kb) > 90 Then sm(kb) = sm(kb) - 90
           For y = 0 To 99 Step 1
        Text3(y).Text = sm(kb)
          kb = kb + 1
         count = 0
         vrNum = Text3(y).Text
         For Each vrNum In Text3()
            lgWhere = StrComp(Text3(y).Text, vrNum, 0)
            If lgWhere = 0 And count > y Then
                Text3(y).BackColor = vbGreen
                vrNum.BackColor = vbGreen
                          End If
            count = count + 1
            
        Next vrNum
        Next y
Next j
Next i

pero mi da errore, praticamete determino Text3 che va da 0 a 99
sm(kb) ha dei valori che devono essere restituiti nella text3.ext


pero' nonfunge