Excel VBA实现跨工作表复制信息并随机排序姓名

Hey there! Your current code just copies the data directly without shuffling it—let's tweak that to make sure names and their matching phone numbers stay paired while getting randomly sorted. Here are two solid approaches to solve this:

Approach 1: Fisher-Yates Shuffle with Arrays (Most Efficient) #

This method uses an array to handle the data and the Fisher-Yates shuffle algorithm (a fair, efficient way to randomize items) to keep name-phone pairs intact.

Sub GenerateRandomNamesWithPhones()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim dataArray As Variant
    Dim randomIndices() As Integer
    Dim i As Integer, j As Integer, tempIndex As Integer
    
    ' Set up your worksheet references
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Set targetSheet = ThisWorkbook.Sheets("RandomNames")
    lastRow = 70 ' You specified rows 3 to 70
    
    ' Load the name-phone pairs into an array (faster than cell operations)
    dataArray = sourceSheet.Range("A3:B" & lastRow).Value
    
    ' Create an array of indices to shuffle
    ReDim randomIndices(1 To UBound(dataArray, 1))
    For i = 1 To UBound(randomIndices)
        randomIndices(i) = i
    Next i
    
    ' Shuffle the indices using Fisher-Yates algorithm
    Randomize ' Initialize random number generator
    For i = UBound(randomIndices) To 2 Step -1
        j = Int(Rnd() * i) + 1
        ' Swap indices
        tempIndex = randomIndices(i)
        randomIndices(i) = randomIndices(j)
        randomIndices(j) = tempIndex
    Next i
    
    ' Write the shuffled pairs to the target sheet
    For i = 1 To UBound(randomIndices)
        targetSheet.Range("A" & i + 2).Value = dataArray(randomIndices(i), 1) ' Start at A3 (i+2 = 3 when i=1)
        targetSheet.Range("B" & i + 2).Value = dataArray(randomIndices(i), 2)
    Next i
End Sub

How this works: #

• We first load all your name-phone data into a VBA array—this is way faster than manipulating cells directly, especially with larger datasets.
• We create an array of indices (1 to 68, since rows 3-70 is 68 rows) and shuffle those indices randomly.
• Finally, we use the shuffled indices to pull data from the original array and write it to the RandomNames sheet—ensuring each name stays linked to its phone number.

Approach 2: Helper Column with Random Numbers (More Intuitive) #

If you prefer a simpler, more visual approach, you can add a temporary helper column of random numbers, sort by that column, then copy the paired data.

Sub GenerateRandomNamesWithHelperColumn()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Set targetSheet = ThisWorkbook.Sheets("RandomNames")
    lastRow = 70
    
    ' Add a helper column with random numbers
    sourceSheet.Range("C3:C" & lastRow).Formula = "=RAND()"
    
    ' Sort the data by the helper column to shuffle name-phone pairs
    With sourceSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=sourceSheet.Range("C3:C" & lastRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending
        .SetRange sourceSheet.Range("A3:C" & lastRow)
        .Header = xlNo
        .Orientation = xlTopToBottom
        .Apply
    End With
    
    ' Copy the shuffled name-phone pairs to the target sheet
    sourceSheet.Range("A3:B" & lastRow).Copy targetSheet.Range("A3")
    
    ' Clear the helper column (optional, clean up after yourself!)
    sourceSheet.Range("C3:C" & lastRow).ClearContents
End Sub

How this works: #

• We add a temporary column (C3:C70) with random numbers using Excel's RAND() function.
• We sort the entire range (A3:C70) by the random numbers—this shuffles the rows, keeping names and phones paired.
• We copy the shuffled A and B columns to RandomNames, then clear the helper column to tidy up.

Either method will get you exactly what you need: randomly ordered names with their matching phone numbers intact.

内容的提问来源于stack exchange，提问作者Kalin Stoev