how to shuffle a Large String in a cell?

[jamiguel77]

hi in cell A1 i have this String

ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789.

in A2 i want the result shuffled random the string...


any advice?

Thanks

 

[lrobbo314]

How about this?

2Book1.xlsx
	A	B
1	ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789	9pAiGHxSDUZV68bRLMqdeuXoNKnEh3TzcW4srfFlw50Bj2YtgaQOkJCP7Ivym1
2	ABC123	B23A1C
Sheet2

Cell Formulas
Range	Formula
B1:B2	B1	=SCRAMBLE(A1)

Function SCRAMBLE(s As String)
Dim LS As Integer:      LS = Len(s)
Dim AL As Object:       Set AL = CreateObject("System.Collections.ArrayList")
Dim RI As Integer

For i = 1 To LS
    AL.Add Mid(s, i, 1)
Next i

Do Until AL.Count = 0
    RI = Int((AL.Count) * Rnd())
    SCRAMBLE = SCRAMBLE & AL.Item(RI)
    AL.removeat RI
Loop

End Function

 

[jamiguel77]

Thanks

 

[jamiguel77]

Much thanks, if can....

Based in your Sample, in A3 i want write by sample: APPLE
in A4 wich is the result ?

in this case would be: 9RRVG

Thanks

 

[johnnyL]

@lrobbo314 Perhaps replace:

Dim LS As Integer:      LS = Len(s)
Dim AL As Object:       Set AL = CreateObject("System.Collections.ArrayList")

For i = 1 To LS
    AL.Add Mid(s, i, 1)
Next i

with:

    s = Split(StrConv(s, 64), Chr(0))       ' Create 1D zero based array of characters
    ReDim Preserve s(0 To UBound(s) - 1)    ' Remove the last blank slot from array 's'

 

[Rick Rothstein]

    s = Split(StrConv(s, 64), Chr(0))       ' Create 1D zero based array of characters
    ReDim Preserve s(0 To UBound(s) - 1)    ' Remove the last blank slot from array 's'

I usually do the above this way...

s = Split(Trim(Replace(StrConv(s, vbUnicode), Chr(0), " ")))

 

[Phuoc]

Or try

Public Function RandomChar(ByVal s As String) As String
Application.Volatile
Dim i As Long, lenS As Long, r As Long, temp As String
Randomize
lenS = Len(s)
For i = 1 To lenS
    r = Int(Rnd() * lenS) + 1
    temp = Mid(s, i, 1)
    Mid(s, i, 1) = Mid(s, r, 1)
    Mid(s, r, 1) = temp
Next i
RandomChar = s

End Function

 

[lrobbo314]

@lrobbo314 Perhaps replace:

Dim LS As Integer:      LS = Len(s)
Dim AL As Object:       Set AL = CreateObject("System.Collections.ArrayList")

For i = 1 To LS
    AL.Add Mid(s, i, 1)
Next i

with:

    s = Split(StrConv(s, 64), Chr(0))       ' Create 1D zero based array of characters
    ReDim Preserve s(0 To UBound(s) - 1)    ' Remove the last blank slot from array 's'

That really wouldn't work for what I am doing. The way I am doing it, it takes a random element from the arraylist, adds it to the result, then removes that element from the arraylist until it's empty.

Looks like I could do what your saying if I were to do something like what @Phouc suggested. Or use a byteArray, as well.

Function SB(s As String) As String
Dim BA() As Byte:   BA = s
Dim MX As Integer:  MX = UBound(BA)
Dim POS As Integer

For i = 0 To MX Step 2
    POS = VBA.Round(Int(MX * rand) / 2) * 2
    tmp = BA(i)
    BA(i) = BA(POS)
    BA(POS) = tmp
Next i

SB = BA
End Function

But looking at Post#4, I think the OP isn't looking for a cypher or something because I guess APPLE should be converted to 9RRVG. The 2 Rs make me think that it's more about converting the string to an, for lack of a better term, 'encrypted' version of the string.

 

[lrobbo314]

If I'm correct and the OP is looking for a cypher, or whatever you would call it, this seems to do what he's looking for.

20220707 Stat Pull Venuti Deaths and Rescues II.xlsm
	A	B
1	APPLE	H00OT
2	APPLE	DOO2e
3	APPLE	qVVOL
4	APPLE	NKKBc
5	APPLE	FggPD
6	APPLE	WNNHD
7	APPLE	dQQVX
8	APPLE	RPPCC
9	APPLE	LFFIK
10	APPLE	unnAd
11	APPLE	EQQ2O
12	APPLE	FEEkG
13	APPLE	jMMhI
14	APPLE	gCCEz
15	APPLE	OGGMY
16	APPLE	UWWNE
17	APPLE	NMME0
18	APPLE	GRRNp
19	APPLE	nCCbj
20	APPLE	PqqDL
Sheet5

Cell Formulas
Range	Formula
B1:B20	B1	=ShuffleII(A1)

Function ShuffleII(s As String) As String
Randomize
Dim ORG() As Byte:  ORG = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
Dim XA() As Byte:   XA = SB("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
Dim SA() As Byte:   SA = s

For i = 0 To UBound(SA) Step 2
    For j = 0 To UBound(ORG) Step 2
        If SA(i) = ORG(j) Then SA(i) = XA(j)
    Next j
Next i

ShuffleII = SA
End Function

Function SB(s As String)
Dim BA() As Byte:   BA = s
Dim MX As Integer:  MX = UBound(BA)
Dim POS As Integer

For i = 0 To MX Step 2
    Randomize
    POS = VBA.Round(Int(MX * Rnd()) / 2) * 2
    tmp = BA(i)
    BA(i) = BA(POS)
    BA(POS) = tmp
Next i

SB = BA
End Function

 

[johnnyL]

Looks like I could do what your saying if I were to do something like what @Phouc suggested. Or use a byteArray, as well.

Function SB(s As String) As String
Dim BA() As Byte:   BA = s
Dim MX As Integer:  MX = UBound(BA)
Dim POS As Integer

For i = 0 To MX Step 2
    POS = VBA.Round(Int(MX * rand) / 2) * 2
    tmp = BA(i)
    BA(i) = BA(POS)
    BA(POS) = tmp
Next i

SB = BA
End Function

That is, by far, the fastest code, thus far in this thread, to 'shuffle' the original string.

0.0000568709384424 Average Seconds on my old laptop. Nearly twice as fast as
Code from @Phuoc post #7 = 0.00009700909167802 Average Seconds

Version I came up with was a seemingly turtle paced 0.00027367855909684 Average Seconds.