Processo somiglianza tra n stringhe

Hai un problema con Excel?

Nuova discussione

Processo somiglianza tra n stringhe
di Migua Ing data: 27/01/2016 13:32:58
Ciao a tutti, sto cercando di implementare un piccolo algoritmo che consente un avvicinamento tra stringhe selezionando alcuni parametri. ma stò trovando difficoltà per limplementazione dello step 2. Vi espongo il mio problema:

In questo esempio , sono presenti 10 stringhe, composte da 10 numeri, sempre uguali = ( 13, 5, 78, 789, 77, 11, 116, 6, 31, 55 ), cambia solo la loro distribuzione, che avviene in maniera random.

Step 1 : Calcolo dist. di Hammnig ( step completo)
- Selezionare la stringa di riferimento "Select Row"

- si crea la matrice 0/1 a dx. ( Tale matrice viene creata controllando tutte le stringhe rispetto alla Select Row) attraverso alcune righe di codice VBA.
Successivamente, tramite l'operatore Somma nella matrice 0/1, Calcolo la distanza di Hamming come somma dei valori presenti =1, per singola riga.

Step 2: Cambiamento (step da implementare)
Inserendo i parametri
- "Loop Tot" (dove indica il numero totale di iterazioni da compiere)
- " n. cambiamenti per Loop"(definre il numero di celle che cambiano(tra quelle uguai a 1) ed assumono un valore di cella uguale alla stringa selezionata).

Sto cercando quindi d'implementare un pezzo di codice VBA che mi consente di far cambiare le celle delle n-1 stringhe rispetto alla stringa selezionata ( Select Row) se sono diverse, quindi con valore corrispondente nella matrice 0/1 uguale a 1.
In modo tale da assomigliare ,loop dopo loop alla stringa selezionata (quindi la distanza di Hamming dovrebbe diminuire sempre più) .
Avendo come vincolo che la scelta del numero di celle da cambiare ogni loop deve essere il minimo tra il parametro impostato precedentemente "n. cambiamenti per loop" e la " dist. Hamming".
Il passaggio in cui sto trovando difficoltà, sta nel fatto che questo processo di cambiamento deve avvenire in maniera casuale, cioè la scelta delle celle che devono diventare uguali alla celle della Select Row deve essere random; e devono variare per ogni loop un numero di celle pari al minimo tra( dist. Hamming; n. cambiamenti per loop).
Spero di essere stato chiaro nello spiegare gli step, allego inoltre il file excel su cui sto lavorando per una più facile comprensione del tutto.
Spero tanto che i membri di questo eccezionale forum, possano dare qualche consiglio per superare tale difficoltà.
Mirko
di Mohican1989 data: 28/01/2016 23:11:08
Ciao, alcune domande:
Quello che deve essere causale è quindi la scelta delle celle che contengono il numero diverso da quelli contenuti nella stringa di riferimento giusto? Per cui a meno che non ti serva un generatore di numeri casuali più vicino al reale casuale e non allo pseudo casuale la funzione rand per restituire un numero da 1-10 come riga e da 1 a 10 come colonna facendo un altro "lancio" del numero casuale nel caso in cui l indirizzo di cella risultante sia uno di quelli sulla riga di riferimento dovrebbe bastare per far decidere "casualmente" le celle da cambiare. Il numero di cambiamenti per loop lo puoi decidere tu? Il cambiamento del numero casualmente scelto che tipo di cambiamento deve essere? Cioè deve per forza farlo cambiare in modo da produrre 0 con la cella della stringa di riferimento o deve essere il risultato di una operazione specifica? Il minore tra distanza di hamming e cambiamenti sembra doversi riferire a una singola riga questo vuol dire che posso anche non effettuare cambiamenti se vengono scelti per esempio 4 numeri sulla stessa riga e il minore tra distanza di Hamming e tentativi è uguale a 2? Nella cella n di iterazione cosa deve essere indicato?
di Migua Ing data: 29/01/2016 00:15:28
Ciao Mohican

Esatto, quello che deve essere casuale è la scelta delle celle che contengono il numero diverso da quelli contenuti nella stringa di riferimento.
Lo pseudo casuale della funzione Rand va più che bene,
Il numero di cambiamenti per loop, lo posso decidere io attraverso la cella (3, 14) di nome "n. cambiamenti per loop".

Il cambiamento del numero casualmente scelto deve per forza farlo cambiare in modo da produrre 0 con la cella della stringa di riferimento e non è il risultato di una operazione specifica.

Ad esempio, Se ho 10 stringhe composte da 10 colonne ( come nel file allegato ).
Scelgo la stringa di riferimento, quindi tutte le restanti 9 stringhe devono cambiare il loro valore all'interno di ogni cella e diventare uguali ( dove prima non lo erano e quindi con valori della matrice 0/1=1) alle celle della stringa di riferimento.
Il ragionamento di scelta delle celle che devono cambiare deve essere casuale ( o pseudo-casuale) ed il numero di celle che devono cambiare per ogni n-1 stringhe lo devo impostare io nella cella "n. cambiamenti per loop".
Infine deve scegliere se cambiare un numero di celle pari al minimo tra "n. cambiamenti per loop" ed "dist. Hamming".
Quindi se ho:

n. cambiamenti per loop =4
dist. Hamming = 2

dovrà cambiare un valore di celle pari a 2.
Per i numeri che abbiamo ipotizzato nell'esempio, le dist. Hamming delle n-1 stringhe dovrebbero andare a zero nel giro di 4/5 loop.
Secondo te, è fattibile ciò che penso?
Ti ringrazio molto per l' interessamento.
di patel data: 29/01/2016 10:10:50
cit.
Esatto, quello che deve essere casuale è la scelta delle celle che contengono il numero diverso da quelli contenuti nella stringa di riferimento.
Lo pseudo casuale della funzione Rand va più che bene...

se va bene Rand qual'è il problema ?
di Migua Ing data: 29/01/2016 13:19:30
Il problema consiste nell'implementare il codice in VBA, che mi consente di fare quando detto precedentemente, impostando i parametri " n. cambiamenti per loop" ed " Loop Tot" pigiando un nuovo bottone.
Purtroppo non sono molto esperto nella programmazione in VBA e non riesco a risolvere questo step, quindi chiedo il vostro prezioso aiuto, per risolvere questo step.

di Mohican1989 data: 30/01/2016 12:05:16
Ciao Migua, ti allego e posto per la visione immediate quanto elaborato fin ora, non è quello che volevi fare tu ma è per darti dei pezzi di codice VBA da cui puoi prendere spunto e implementare tu stesso o vedere quello che fino ad ora ho capito io.

Non ho capito delle cose:
- Io genero la prima cella casuale, la cambio in modo da avere 0 per quella cella come distanza calcolata,ricalcolo la distanza di hamming che sarà diminuita di 1 e ora ? Devo continuare sulla stessa riga ?
Genero una nuova cella ? Con contare i loop, cosa pensi sia fatto all' interno del loop ? Perchè io posso pensare che il loop sia quante volte devo creare numeri casuali al fine di far diventare tutte le distanze di hamming pari a 0 allora ci vorrebbero molto più che solo 4/5 loop.

EDIT: Ho riletto il primo post, io ho dato per scontato che tu volessi azzerrare la distanza di hamming di tutte le stringhe, quindi ora mi chiedo è corretto che tu possa scrivere n. cambiamenti = 3, avere dista. hamming = 10 e ritrovarti comunque con una distanza non azzerata corretto ? Dovrei quindi tenere un contatore che indichi quante volte ho già cambiato una cella su una determinata riga.

Option Explicit
Sub Azzera_Distanza()
'Dichiaro le variabili
Dim StringheTotali As Integer, NumerixStringa As Integer, NCambiamenti As Integer, DistanzaHamming As Integer
Dim StringaRiferimento As Integer
Dim X As Integer, DadoRighe As Integer, DadoColonne As Integer
Dim CellaCasuale As Range

'Imposto dei riferimenti nel caso si aggiungessero stringhe o numeri alle stringhe
StringaRiferimento = Range("B3")
StringheTotali = Range("C7").End(xlDown).Row - 6
NumerixStringa = Range("D6").End(xlToRight).Column - 4
NCambiamenti = Range("M3")
'imposto dei check non esaustivi per controllare almeno che i campi "select row" e "n. cambiamenti loop"
'non siano lasciati vuoti.
If NCambiamenti = 0 Then MsgBox ("Hai dimenticato di inserire il numero di cambiamenti"), vbCritical + vbOKOnly, "Check N. Cambiamenti": Exit Sub
If StringaRiferimento = 0 Then MsgBox ("Hai dimenticato di inserire la stringa di riferimento"), vbCritical + vbOKOnly, "Check Riga riferimento": Exit Sub


'Imposto etichetta nel caso la generazione del numero casuale che sarà utilizzato come riferimento di riga della
'cella casuale sia uguale alla riga della stringa di riferimento (non vogliamo cambiare le celle della stringa di
'riferimento)
lanciadadorighe:
'genero il numero di riga casuale
DadoRighe = Application.WorksheetFunction.RandBetween(1, StringheTotali)
If DadoRighe = StringaRiferimento Then GoTo lanciadadorighe 'se è uguale alla riga della stringa genera ancora
'genero il numero di colonna casuale
DadoColonne = Application.WorksheetFunction.RandBetween(1, NumerixStringa)
'imposto la cella
Set CellaCasuale = Cells(6 + DadoRighe, 3 + DadoColonne)
CellaCasuale.Select 'la seleziono solo per comodità quando eseguo il codice passo passo posso vedere la cella selezionata

'Faccio diventare la cella uguale a quella di riferimento posta sulla stessa colonna.
CellaCasuale = Cells(6 + StringaRiferimento, 3 + DadoColonne)

'ricalcolo le distanze di hamming (ci servirà più tardi per tenere aggiornate le distanze e confrontarle con gli n.cambiamenti)
Call calcola_distanze

End Sub

di Migua Ing data: 30/01/2016 18:10:35
Ciao Mohican, intanto ti ringrazio e ti stimo molto per il supporto che stai fornendo.

Ho provato ad elencare passo passo quello che dovrebbe accadere all'interno di ogni loop, spero che questo possa rispondere alle tue domande, e rendere più chiaro quello che sto pensando, nel frattempo provo il codice che hai allegato.

Inizio Loop:

controllo (1) scelta dell'operatore

controllo la dist. Hamming ( per ogni riga, tranne la stringa di riferimento)
- se "Dist. Hamming" (i-esima) < " n. cambiamenti per Loop", allora
"N. cambiamenti per Loop" = Dist. Hamming( i-esima, per ogni stringa)
( quindi uso Dist. Hamming come operatore per la scelta del numero di celle)
- Altrimenti utilizzo "n. cambiamenti per Loop" come operatore.

Quindi dopo aver scelto il numero di celle da cambiare per ogni stringa

controllo (2)

controlla se le n celle selezionate hanno valore uguale a 1 ( nella matrice di destra)
- se si, allora aggiorno valore delle n celle in modo che diventi zero ( copiando il valore che si trova nella cella della Select Row (uguale colonna).
- se no, non fare nulla.

Calcolo nuova dist. Hamming per ogni riga

End Loop

In questo modo il valore della distanza di Hamming (per ogni riga) non è detto che diminuisce sicuramente di 3,( se 3 è il valore che vado ad inserire in "n. cambiamenti per loop"; operatore).
Dato che avvengono i controlli (1) e (2), quindi la scelta del numero di celle da cambiare per ogni stringa ad ogni loop non è fissa, ma dovrebbe variare in funzione dei 2 operatori, "dist. Hamming" ed "n. cambiamenti per Loop".

Grazie mille Mohican

EDIT: ho visionato il file che hai allegato, ed il ragionamento funziona, grande lavoro!!!! Adesso sto provando ad implementare il parametro "n. cambiamenti per Loop" ed i controlli (1) e (2), descritti sopra, in modo tale da avere un cambiamento di più celle per stringa, contemporaneamente in tutte le n-1 stringhe. Spero di riuscire nell'impresa.
di Mohican1989 data: 30/01/2016 21:00:03
Scusa forse mi sto perdendo in un bicchier d'acqua,l' implementazione del codice non è difficile ma ogni volta mi blocco nella logica del tutto.

CONTROLLO 1
Controllo per ogni stringa il minore tra n.cambiamenti inserito e dist. hamming --> FATTO
CONTROLLO 2
Controllare se le N celle selezionate sono uguali a 1 --> IN PARTE,
è sicuramente facile fare questo controllo ma non si è deciso da nessuna parte quante celle casuali selezionare, se devono essere prima selezionate N celle a caso di ogni riga oppure selezionate N celle a caso tra tutte le righe disponibili, per cui magari seleziono 1 cella nella prima riga, 1 nell quarta, 1 nella seconda in quest ordine.
Mi sono bloccato qui ^^
di Migua Ing data: 30/01/2016 23:51:51
La quantità di celle da selezionare lo si decide settando l'operatore "n. cambiamenti per loop" ( cella M3).

Per esempio se "n. cambiamenti per loop"=5, allora per ogni stringa, saranno 5 le celle da cambiare ( contemporaneamente in tutte le righe).
La scelta delle 5 celle da cambiare all'interno di ogni stringa avviene in modo casuale.
A questo punto deve essere effettuato il controllo(1) per ogni stringa, in modo tale da decidere quante celle cambiare stringa dopo stringa, tra il min(5, dist. Hamming).

Dopo di che, si effettua il controllo (2),
controlla se le n celle selezionate hanno valore uguale a 1 ( nella matrice di destra)
- se si, allora aggiorno valore delle n celle in modo che diventi zero ( copiando il valore che si trova nella cella della Select Row (uguale colonna).
- se no, non fare nulla.

Quindi per ogni stringa le n celle selezionate ( dove n= min(5, dist. Hamming)), se uguali a 1 devono cambiare il loro valore.

Dopo i due controlli la quantità delle n celle da cambiare potrà essere diversa per ogni stringa. Questo perchè, durante i primi loop, sicuramente cambieranno un numero di celle pari a 5, ma quando la dist. Hamming diminuirà, assumendo valori < 5, allora il numero di celle da cambiare per ogni stringa sarà uguale al valore della Dist. Hamming per la stringa di riferimento.

esempio: se nella prima stringa avrò dist. Hamming =4 e nella seconda stringa avrò dist. Hamming = 1; allora nella prima stringa si dovranno cambiare 4 celle (scelte in maniera casuale) e nella seconda stringa dovra cambiare 1 cella ( scelta in maniera casuale), rispetto alla "select row"

Infine ricalcolare la Dist. Hamming

Spero di essermi spiegato un po meglio.
grazie mille Mohican

di Mohican1989 data: 02/02/2016 01:30:54
Ciao Migua
Ci ho messo un pò, vorrei finire tutti i progetti a cui cerco di dare un mano.
Io ti allego file e codice.
Probabilmente non è ancora come lo vuoi tu, spero di aver capito tutte le istruzioni nel modo corretto.
I loop sono molti di più di quelli che servono, di fatto quando ho provato mi sono serviti min 23 loop e massimo 46.
Questo per riuscire ad azzerare le distanze di hamming scegliendo la casualmente la colonna della cella da selezionare su ogni riga.
Probabilmente a te non serviva azzerarle ma dovresti poter tagliare il codice che non serve.
Dimmi cosa ce da cambiare che lo cambiamo, ciao.

Option Explicit
Option Base 1


Sub Azzera_Distanza()
'Dichiaro le variabili
Dim StringheTotali As Integer, NumerixStringa As Integer, NCambiamenti As Integer, DistanzaHamming As Integer
Dim StringaRiferimento As Integer
Dim X As Integer, Y As Integer, Z As Integer, DadoRighe As Integer, DadoColonne As Integer
Dim QntaCambiamenti As Integer
Dim OperatoreArray()
Dim CelleCasuale As Range
Dim Contatoreloop As Integer



'Imposto dei riferimenti nel caso si aggiungessero stringhe o numeri alle stringhe
StringaRiferimento = Range("B3")
StringheTotali = Range("C7").End(xlDown).Row - 6
NumerixStringa = Range("D6").End(xlToRight).Column - 4
NCambiamenti = Range("M3")
'imposto dei check non esaustivi per controllare almeno che i campi "select row" e "n. cambiamenti loop"
'non siano lasciati vuoti.
If NCambiamenti = 0 Then MsgBox ("Hai dimenticato di inserire il numero di cambiamenti"), vbCritical + vbOKOnly, "Check N. Cambiamenti": Exit Sub
If StringaRiferimento = 0 Then MsgBox ("Hai dimenticato di inserire la stringa di riferimento"), vbCritical + vbOKOnly, "Check Riga riferimento": Exit Sub


Contatoreloop = 0
'Verifico per ogni stringa il minore tra la distanza di hamming e il n. di cambiamenti richiesto per poi caricarli in un array
rielabora:
For X = 1 To StringheTotali
    ReDim Preserve OperatoreArray(StringheTotali)
    If Cells(6 + X, 14) > NCambiamenti Then
        OperatoreArray(X) = NCambiamenti
    Else
        OperatoreArray(X) = Cells(6 + X, 14)
    End If
Next


For Z = 1 To StringheTotali
    For Y = 1 To OperatoreArray(Z)
            If Y <> StringaRiferimento Then
                DadoColonne = Application.WorksheetFunction.RandBetween(1, NumerixStringa)
                Set CelleCasuale = Cells(6 + Z, 3 + DadoColonne)
                If CelleCasuale <> Cells(6 + StringaRiferimento, 3 + DadoColonne) Then
                    CelleCasuale = Cells(6 + StringaRiferimento, 3 + DadoColonne)
                Else
                    'Niente
                End If
            Else
                'Niente
            End If
    Next
    Call calcola_distanze_nomsg
Next

Contatoreloop = Contatoreloop + 1

If Application.WorksheetFunction.Sum(Range("N7:N16")) <> 10 Then
    GoTo rielabora
Else
Range("K3") = Contatoreloop
MsgBox ("FINITO !")
End If

Set CelleCasuale = Nothing
Erase OperatoreArray


End Sub
Sub calcola_distanze_nomsg()
Dim k As Integer
Dim LoopCol As Integer
Dim LoopRig As Integer
k = Cells(3, 2)
For LoopCol = 1 To 10
    For LoopRig = 1 To 10
        If LoopRig <> k Then
            If Cells(LoopRig + 6, LoopCol + 3) = Cells(k + 6, LoopCol + 3) Then
            Cells(LoopRig + 6, LoopCol + 14) = 0
            ElseIf Cells(LoopRig + 6, LoopCol + 3) <> Cells(k + 6, LoopCol + 3) Then
            Cells(LoopRig + 6, LoopCol + 14) = 1
            End If
        ElseIf LoopRig = k Then
        End If
    Next LoopRig
Next LoopCol

End Sub

di Migua Ing data: 04/02/2016 23:52:58
Ciao Mohican
Ti ringrazio davvero tanto per il lavoro che hai fatto; veramente notevole!!
Ho modificato un pò il file che hai allegato, aggiungendo un secondo bottone, per lo step di avvicinamento, in modo tale da poter gestire meglio i singoli passaggi del codice.
Inoltre aggiungendo :
If Contatoreloop = cells(3, 9) Then GoTo terminaprocesso; in una nuova cella posso settare il numero di loop massimi, in modo tale da bloccare il sistema al suo raggiungimento.
Adesso l'ultima cosa da cambiare, di cui mi sono reso conto solamente adesso, vedendo l'effettivo funzionamento dell'algoritmo, è che per ogni stringa non ci possono essere ripetizioni di numeri uguali con conseguente perdita dei numeri sovrascritti, mi spiego meglio:

Ad esempio, se ho due stringhe composte dai seguenti numeri (tutti diversi tra loro e senza ripetizioni):
1 2 3 4 5 6
3 2 1 4 6 5

Avviando l'algoritmo, con cambiamento "Ncambiamenti per Loop"=1, selezionando la prima stinga come "Select Row".
Casualmente nella seconda stringa si sceglie il cambiamento della prima cella, (essendo diversa dalla "Select Row") cambiando nella seconda stringa il 3 con 1, nello stesso istante il numero 1 presente nella terza cella della seconda stringa deve assumere il valore della prima cella (cella selez. casualmente) della medesima stringa, quindi diventa 3.
In modo tale da avere questo risultato:
1 2 3 4 5 6 (Select Row)
1 2 3 4 6 5
Grazie a questo meccanismo si dovrebbe evitare la presenza di numeri ripetuti per le n-1 stringhe, attualmente l'algoritmo attua il cambiamento in questo modo per la seconda stringa, con le medesime condizioni di partenza:
1 2 3 4 5 6 (Select Row)
1 2 1 4 6 5
quindi si presentano due numeri ripetuti nella seconda stringa (il numero 1), con conseguente perdita del numero 3 nella seconda stringa.
Chiedo per l'ultima volta il tuo prezioso aiuto, mi manca solamente questa correzione per raggiungere l'obiettivo; secondo te è possibile fare ciò?
Ti allego il file che ho modificato.
Ti ringrazio tanto Mohican.
EDit: ti allego un esempio scritto a mano per farti comprendere meglio l'ultima modifica.

di Mohican1989 data: 07/02/2016 13:31:15
Ciao riposto il codice, ATTENZIONE, bisogna controllare e non ho fatto una macro per farlo, che tutte le stringhe abbiano gli stessi numeri 1 volta nella stringa, ad esempio nel file che hai allegato alcune stringhe hanno già al loro interno numeri doppi, dovrebbero partire "pure", ma immagino sia colpa per colpa della macro già attivata e che quindi ha cambiato il contenuto della stringa.

Ad ogni modo ad ora ho messo nel codice la riga IF NOT CELLADOPPIA IS NOTHING THEN cioè solo se la che diventerebbe doppia è stata trovata allora cambiala con il valore della cellacasuale altrimenti via avanti come se niente fosse.

Se togli quella riga e esegui la macro con stringhe contenenti doppioni (quindi non tutti i 10 numeri singolarmente) restituirà un errore in quanto non riuscirà a trovare la cella che diventerebbe doppia al momento della sostituzione. Spero di essermi spiegato.

Private Sub CommandButton1_Click()
'Dichiaro le variabili
Dim StringheTotali As Integer, NumerixStringa As Integer, NCambiamenti As Integer, DistanzaHamming As Integer
Dim StringaRiferimento As Integer
Dim X As Integer, Y As Integer, Z As Integer, DadoRighe As Integer, DadoColonne As Integer
Dim QntaCambiamenti As Integer
Dim OperatoreArray()
Dim CelleCasuale As Range
Dim Contatoreloop As Integer
Dim RangeStringa As Range






'Imposto dei riferimenti nel caso si aggiungessero stringhe o numeri alle stringhe
StringaRiferimento = Range("B3")
StringheTotali = Range("C7").End(xlDown).Row - 6
NumerixStringa = Range("D6").End(xlToRight).Column - 4
NCambiamenti = Range("M3")
'imposto dei check non esaustivi per controllare almeno che i campi "select row" e "n. cambiamenti loop"
'non siano lasciati vuoti.
If NCambiamenti = 0 Then MsgBox ("Hai dimenticato di inserire il numero di cambiamenti"), vbCritical + vbOKOnly, "Check N. Cambiamenti": Exit Sub
If StringaRiferimento = 0 Then MsgBox ("Hai dimenticato di inserire la stringa di riferimento"), vbCritical + vbOKOnly, "Check Riga riferimento": Exit Sub

Contatoreloop = 0
'Verifico per ogni stringa il minore tra la distanza di hamming e il n. di cambiamenti richiesto per poi caricarli in un array
rielabora:
For X = 1 To StringheTotali
    ReDim Preserve OperatoreArray(StringheTotali)
    If Cells(6 + X, 14) > NCambiamenti Then
        OperatoreArray(X) = NCambiamenti
    Else
        OperatoreArray(X) = Cells(6 + X, 14)
    End If
Next


For Z = 1 To StringheTotali
    For Y = 1 To OperatoreArray(Z)
            If Y <> StringaRiferimento Then
                DadoColonne = Application.WorksheetFunction.RandBetween(1, NumerixStringa)
                Set CelleCasuale = Cells(6 + Z, 3 + DadoColonne)
                CelleCasuale.Select
                 Set RangeStringa = Range(Cells(6 + Z, 4), Cells(6 + Z, 13))

               
                If CelleCasuale <> Cells(6 + StringaRiferimento, 3 + DadoColonne) Then
                    valoreriferimento = Cells(6 + StringaRiferimento, 3 + DadoColonne)
                    Set celladoppia = RangeStringa.Find(what:=valoreriferimento)
                    If Not celladoppia Is Nothing Then
                     celladoppia.Value = CelleCasuale.Value
                    End If
                    CelleCasuale = Cells(6 + StringaRiferimento, 3 + DadoColonne)
                   CelleCasuale.Select
                Else
                    'Niente
                End If
            Else
                'Niente
            End If
    Next
    
    
Dim k As Integer
Dim LoopCol As Integer
Dim LoopRig As Integer
k = Cells(3, 2)
For LoopCol = 1 To 10
    For LoopRig = 1 To 10
        If LoopRig <> k Then
            If Cells(LoopRig + 6, LoopCol + 3) = Cells(k + 6, LoopCol + 3) Then
            Cells(LoopRig + 6, LoopCol + 14) = 0
            ElseIf Cells(LoopRig + 6, LoopCol + 3) <> Cells(k + 6, LoopCol + 3) Then
            Cells(LoopRig + 6, LoopCol + 14) = 1
            End If
        ElseIf LoopRig = k Then
        End If
    Next LoopRig
Next LoopCol


Next

Contatoreloop = Contatoreloop + 1

'imposto limite di Loop Tot
If Contatoreloop = Cells(3, 9) Then GoTo terminaprocesso



If Application.WorksheetFunction.Sum(Range("N7:N16")) > 1 Then  'da qui si pu impostare il numero minimo di stringhe per bloccare i loop

    GoTo rielabora
    
Else

terminaprocesso:
Range("K3") = Contatoreloop

MsgBox ("FINITO !")
End If

Set CelleCasuale = Nothing
Erase OperatoreArray


End Sub


Private Sub CommandButton2_Click()
Dim k As Integer
Dim LoopCol As Integer
Dim LoopRig As Integer
k = Cells(3, 2)
For LoopCol = 1 To 10
    For LoopRig = 1 To 10
        If LoopRig <> k Then
            If Cells(LoopRig + 6, LoopCol + 3) = Cells(k + 6, LoopCol + 3) Then
            Cells(LoopRig + 6, LoopCol + 14) = 0
            ElseIf Cells(LoopRig + 6, LoopCol + 3) <> Cells(k + 6, LoopCol + 3) Then
            Cells(LoopRig + 6, LoopCol + 14) = 1
            End If
        ElseIf LoopRig = k Then
        End If
    Next LoopRig
Next LoopCol
MsgBox ("Calcoli effettuati")
End Sub

di Migua Ing data: 07/02/2016 15:54:29
Ciao Mohican
Ho provato il codice, ed ho verificato che tutte le stringhe abbiano gli stessi numeri 1 volta nella stringa, purtroppo questo non si verifica.
I numeri cambiano come nel codice precedente e se arresto i loop prima della conversione di tutte le stringhe sono presenti numeri doppioni all'interno delle stringhe ( mettendo un numero basso di "Limite Loop"= 3, Cella I3), questo non si deve verificare; quindi anche se blocco dopo due /tre loop, in tab non ci dovrebbero essere doppioni in tutte le stringhe e quindi le distanze di Hamming non diminuiranno di molto con il proseguire dei loop.
Ti ringrazio molto per il supporto, grazie mille Mohican.

PS: per fare delle prove, ho allegato il file Excel modificato dove presente una seconda matrice con una disposizione casuale dei numeri senza ripetizioni, basta cancellare la matrice di lavoro e incollare su quella in fondo per fare nuove prove ed azzerare il contatore Loop.
di Mohican1989 data: 07/02/2016 22:35:38
Stasera non sono riuscito a capire dov è il bug ci riprovo a fine settimana. Non dovrebbe essere possibile far uscire 2 numeri uguali evidentemente c'è un passaggio he mi manca

di Migua Ing data: 09/02/2016 13:32:36
Ciao Mohican, alla fine sono riuscito a risolvere l'ultimo problema,ho aggiunto un ulteriore ciclo For per ogni colonna che effettua un controllo per la presenza di doppioni( Chiamato ControlloDoppioni); ti allego il codice che ho implementato per prenderne visione.
Ti ringrazio davvero molto per il tuo aiuto.
Grazie mille!! Sei un grande!!

Private Sub CommandButton1_Click()
'Dichiaro le variabili
Dim StringheTotali As Integer, NumerixStringa As Integer, NCambiamenti As Integer, DistanzaHamming As Integer
Dim StringaRiferimento As Integer
Dim X As Integer, Y As Integer, Z As Integer, DadoRighe As Integer, DadoColonne As Integer
Dim QntaCambiamenti As Integer
Dim OperatoreArray()
Dim CelleCasuale As Range
Dim Contatoreloop As Integer







'Imposto dei riferimenti nel caso si aggiungessero stringhe o numeri alle stringhe
StringaRiferimento = Range("B3")
StringheTotali = Range("C7").End(xlDown).Row - 6
NumerixStringa = Range("D6").End(xlToRight).Column - 4
NCambiamenti = Range("M3")
'imposto dei check non esaustivi per controllare almeno che i campi "select row" e "n. cambiamenti loop"
'non siano lasciati vuoti.
If NCambiamenti = 0 Then MsgBox ("Hai dimenticato di inserire il numero di cambiamenti"), vbCritical + vbOKOnly, "Check N. Cambiamenti": Exit Sub
If StringaRiferimento = 0 Then MsgBox ("Hai dimenticato di inserire la stringa di riferimento"), vbCritical + vbOKOnly, "Check Riga riferimento": Exit Sub

Contatoreloop = 0
'Verifico per ogni stringa il minore tra la distanza di hamming e il n. di cambiamenti richiesto per poi caricarli in un array
rielabora:
For X = 1 To StringheTotali
    ReDim Preserve OperatoreArray(StringheTotali)
    If cells(6 + X, 14) > NCambiamenti Then
        OperatoreArray(X) = NCambiamenti
    Else
        OperatoreArray(X) = cells(6 + X, 14)
    End If
Next


For Z = 1 To StringheTotali
    For Y = 1 To OperatoreArray(Z)
            If Y <> StringaRiferimento Then
                DadoColonne = Application.WorksheetFunction.RandBetween(1, NumerixStringa)
                Set CelleCasuale = cells(6 + Z, 3 + DadoColonne)
                 CelleCasuale.Select
                 
                 cells(3, 1) = DadoColonne
                 cells(4, 1) = Z
                 
                    Call ControlloDoppioni
                    
                    
                If CelleCasuale <> cells(6 + StringaRiferimento, 3 + DadoColonne) Then
                    CelleCasuale = cells(6 + StringaRiferimento, 3 + DadoColonne)
                   CelleCasuale.Select
                Else
                    'Niente
                End If
            Else
                'Niente
            End If
    Next
    
    
Dim k As Integer
Dim LoopCol As Integer
Dim LoopRig As Integer
k = cells(3, 2)
For LoopCol = 1 To 10
    For LoopRig = 1 To 10
        If LoopRig <> k Then
            If cells(LoopRig + 6, LoopCol + 3) = cells(k + 6, LoopCol + 3) Then
            cells(LoopRig + 6, LoopCol + 14) = 0
            ElseIf cells(LoopRig + 6, LoopCol + 3) <> cells(k + 6, LoopCol + 3) Then
            cells(LoopRig + 6, LoopCol + 14) = 1
            End If
        ElseIf LoopRig = k Then
        End If
    Next LoopRig
Next LoopCol


Next

Contatoreloop = Contatoreloop + 1

'imposto limite di Loop Tot
If Contatoreloop = cells(3, 9) Then GoTo terminaprocesso



If Application.WorksheetFunction.Sum(Range("N7:N16")) > 1 Then  'da qui si pu impostare il numero minimo di stringhe con Dist. Hamming =0, per bloccare i loop

    GoTo rielabora
    
Else

terminaprocesso:
Range("K3") = Contatoreloop

MsgBox ("FINITO !")
End If

Set CelleCasuale = Nothing
Erase OperatoreArray


End Sub


Public Sub ControlloDoppioni()
Dim A As Integer

For A = 4 To 13
        If A <> 3 + cells(3, 1) Then 'controlla che la colonna selezionata non venga inclusa nel loop
                If cells(6 + cells(4, 1), A) = cells(cells(3, 2) + 6, 3 + cells(3, 1)) Then
                 cells(6 + cells(4, 1), A) = cells(6 + cells(4, 1), 3 + cells(3, 1))
                
                End If
        End If
  Next A
End Sub

di Mohican1989 data: 10/02/2016 23:28:47
Bravo, io guarderò per vedere dove ho sbagliato ^^ saluti.

Vuoi Approfondire?