Tirare cinque numbers unici da un intervallo e visualizzare in Caselle di text utilizzando Excel VBA

Ho una tabella di numbers come sotto in un foglio di eccellenza. Tabella di Excel

No1 No2 No3 No4 No5 1 190 134 190 101 10 142 117 10 151 155 12 12 12 128 154 154 154 154 154 

Ho un UserForm con 5 TextBox per visualizzare 5 numbers unici dalla tabella.

Quando faccio clic sul button di command, dovrò tirare 5 numbers UNICI dalla tabella sopra e visualizzarli rispettivamente nei TextBox.

Inoltre, se faccio nuovamente clic sul button di command (cioè clic su più per get più risultati), dovrebbe popolare un numero diverso di UNIQUE dalla tabella.

Ho usato un concetto semplice se altro per get questo ma non funziona correttamente.

Mi aiuti per get il risultato. Grazie!

Utilizzo il seguente codice:

 Private Sub btnGenerate_Click() Dim PresentRow As Byte, PresentColumn As Byte PresentRow = ActiveCell.Row PresentColumn = ActiveCell.Column If PresentRow = 5 And PresentColumn = 1 Then Sheet1.Range("F2").Activate ElseIf PresentRow = 5 And PresentColumn = 5 Then Sheet1.Range("A2").Activate End If Select Case ActiveCell.Column Case 1 TextBox1.Text = ActiveCell.Value If ActiveCell.Offset(0, 1).Value <> TextBox1.Text Then TextBox2.Text = ActiveCell.Offset(0, 1).Value Else TextBox2.Text = ActiveCell.Offset(1, 1).Value End If If ActiveCell.Offset(0, 2).Value <> TextBox2.Text Then TextBox3.Text = ActiveCell.Offset(0, 2).Value Else TextBox3.Text = ActiveCell.Offset(1, 2).Value End If If ActiveCell.Offset(0, 3).Value <> TextBox3.Text Then TextBox4.Text = ActiveCell.Offset(0, 3).Value Else TextBox4.Text = ActiveCell.Offset(1, 4).Value End If If ActiveCell.Offset(0, 4).Value <> TextBox4.Text Then TextBox5.Text = ActiveCell.Offset(0, 4).Value Else TextBox5.Text = ActiveCell.Offset(1, 5).Value End If Case 5 TextBox1.Text = ActiveCell.Value If ActiveCell.Offset(0, -1).Value <> TextBox1.Text Then TextBox2.Text = ActiveCell.Offset(0, -1).Value Else TextBox2.Text = ActiveCell.Offset(1, -1).Value End If If ActiveCell.Offset(0, -2).Value <> TextBox2.Text Then TextBox3.Text = ActiveCell.Offset(0, -2).Value Else TextBox3.Text = ActiveCell.Offset(1, -2).Value End If If ActiveCell.Offset(0, -3).Value <> TextBox3.Text Then TextBox4.Text = ActiveCell.Offset(0, -3).Value Else TextBox4.Text = ActiveCell.Offset(1, -4).Value End If If ActiveCell.Offset(0, -4).Value <> TextBox4.Text Then TextBox5.Text = ActiveCell.Offset(0, -4).Value Else TextBox5.Text = ActiveCell.Offset(1, -5).Value End If End Select Sheet1.Activate ActiveCell.Offset(1, 0).Select End Sub Caso 5 Private Sub btnGenerate_Click() Dim PresentRow As Byte, PresentColumn As Byte PresentRow = ActiveCell.Row PresentColumn = ActiveCell.Column If PresentRow = 5 And PresentColumn = 1 Then Sheet1.Range("F2").Activate ElseIf PresentRow = 5 And PresentColumn = 5 Then Sheet1.Range("A2").Activate End If Select Case ActiveCell.Column Case 1 TextBox1.Text = ActiveCell.Value If ActiveCell.Offset(0, 1).Value <> TextBox1.Text Then TextBox2.Text = ActiveCell.Offset(0, 1).Value Else TextBox2.Text = ActiveCell.Offset(1, 1).Value End If If ActiveCell.Offset(0, 2).Value <> TextBox2.Text Then TextBox3.Text = ActiveCell.Offset(0, 2).Value Else TextBox3.Text = ActiveCell.Offset(1, 2).Value End If If ActiveCell.Offset(0, 3).Value <> TextBox3.Text Then TextBox4.Text = ActiveCell.Offset(0, 3).Value Else TextBox4.Text = ActiveCell.Offset(1, 4).Value End If If ActiveCell.Offset(0, 4).Value <> TextBox4.Text Then TextBox5.Text = ActiveCell.Offset(0, 4).Value Else TextBox5.Text = ActiveCell.Offset(1, 5).Value End If Case 5 TextBox1.Text = ActiveCell.Value If ActiveCell.Offset(0, -1).Value <> TextBox1.Text Then TextBox2.Text = ActiveCell.Offset(0, -1).Value Else TextBox2.Text = ActiveCell.Offset(1, -1).Value End If If ActiveCell.Offset(0, -2).Value <> TextBox2.Text Then TextBox3.Text = ActiveCell.Offset(0, -2).Value Else TextBox3.Text = ActiveCell.Offset(1, -2).Value End If If ActiveCell.Offset(0, -3).Value <> TextBox3.Text Then TextBox4.Text = ActiveCell.Offset(0, -3).Value Else TextBox4.Text = ActiveCell.Offset(1, -4).Value End If If ActiveCell.Offset(0, -4).Value <> TextBox4.Text Then TextBox5.Text = ActiveCell.Offset(0, -4).Value Else TextBox5.Text = ActiveCell.Offset(1, -5).Value End If End Select Sheet1.Activate ActiveCell.Offset(1, 0).Select End Sub 

Di seguito è necessario che Microsoft Scripting Runtime sia aggiunto al progetto tramite Strumenti, Riferimenti.

Nel foglio di codice foglio di lavoro:

 Option Explicit Private Sub CommandButton1_Click() Dim txt As Long, vals As Variant, ky As Variant Dim uniq As New Scripting.Dictionary vals = Range("A2:E5").Value2 uniq.RemoveAll Do While uniq.Count < 5 uniq.Item(vals(Application.RandBetween(LBound(vals, 1), UBound(vals, 1)), _ Application.RandBetween(LBound(vals, 2), UBound(vals, 2)))) = vbNullString Loop TextBox1 = uniq.Keys(0) TextBox2 = uniq.Keys(1) TextBox3 = uniq.Keys(2) TextBox4 = uniq.Keys(3) TextBox5 = uniq.Keys(4) End Sub 

immettere qui la descrizione dell'immagine