درخواست برنامه

[amir0914]

سلام. دوستان در ستون a کلی متن و عدد دارم (که تکراری هم داخلش هست)، میخوام با vba به صورت تصادفی از این ها 5 تا رو منحصر به فرد ( بدون تکراری) در ستون b وارد کنه. ممنون میشم کمکم کنین.

[ahmad.khanifar]

سلام آیا متن و عددهایی که در ستون ا قرار دارند / روی هم و بدون فاصله هستند یا با فاصله خاصی از هم جدا هستند

حالت 1 : ahmad -11622- reza- 2102- ahmad-11371-excel-11540-reza-9090-milad-11622
حالت 2 : ahmad11622reza2102ahmad11371excel11540reza9090mila d11622

[amir0914]

سلام. خروجی یک برنامه تخصصی هست و فاصله مابین سلول ها الگوی خاصی ندارد. مثل عکس این یک نمونه فایل هست.

[Amir Ghasemiyan]

سلام دوست عزیز
خدمت شما

Sub EI_UniuqeRandom()
    Columns("A:A").Copy Range("C1")
    Columns("C:C").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    ActiveSheet.Range("C:C").RemoveDuplicates Columns:=1, Header:=xlNo
    RandNumbers = UniuqeRandom(5, Columns("C:C").CurrentRegion.Count)
    For i = 1 To 5
        Cells(i, 2) = Cells(RandNumbers(i - 1), 3)
    Next i
    Columns("C:C").Clear
End Sub


Function UniuqeRandom(Counter As Integer, RangeCount As Integer)
Dim RandArr() As Variant
ReDim RandArr(0)
i = 0
While i < Counter
    randomnumber = Int((RangeCount - 1) * Rnd)
    If Not (UBound(Filter(RandArr, randomnumber)) > -1) Then
        ReDim Preserve RandArr(i)
        RandArr(i) = randomnumber
        i = i + 1
    End If
Wend
UniuqeRandom = RandArr
End Function