Excel VBA，将信息复制到其他工作表但名称随机答案

【问题标题】：Excel VBA, Copying info to other sheet but with random namesExcel VBA，将信息复制到其他工作表但名称随机
【发布时间】：2018-10-26 02:49:35
【问题描述】：

我的 Excel 程序有问题。我想将姓名和电话号码粘贴到另一张纸上，但姓名必须随机排序，电话号码必须相同。例如，在第一张纸上我有 Kalin Kalinov +22222222 和 Martin Martinov +99119911，在复制粘贴操作后的另一张纸上，它们必须像 Martin Martinov +99119911 和 Kalin Kalinov +22222222。

Sub GenerateNames()
Dim ssheet1 As Worksheet
Dim rnsheet As Worksheet
Set ssheet1 = ThisWorkbook.Sheets("Sheet1")
Set rnsheet = ThisWorkbook.Sheets("RandomNames")

ssheet1.Range("A3:A70").Copy rnsheet.Range("A3:A70")
ssheet1.Range("B3:B70").Copy rnsheet.Range("B3:B70")
End Sub

【问题讨论】：

标签： vba excel sorting range

【解决方案1】：

添加类似这样的内容，并将其应用于源工作表或目标工作表：

Range("C3").Formula = "=RAND()"
Range("C3").AutoFill Destination:=Range("C3:C70")

Range("A:C").Sort key1:=Range("C3"), order1:=xlAscending, Header:=xlYes

它创建一列随机值，用于排序。之后您可能想将其删除。

【讨论】：

【解决方案2】：

Sub randomName()
Dim ws As String, ws2 As String, rg As Range, rg2 As Range
Dim DataRange As Variant, i As Integer
Dim n As Integer, tmp As String
Dim nData As Integer
      '== set by user
            nData = 70        '== data size
            ws = "sheet1":                ws2 = "RandomNames"     '== sheets name
            Set rg = Sheets(ws).Cells(3, 1):            Set rg2 = Sheets(ws2).Cells(3, 1)       '=range with start row
      '== Run
            rg2.Resize(nData, 2).Value = rg.Resize(nData, 2).Value
            DataRange = rg.Resize(nData).Value
            For i = 1 To UBound(DataRange)
                  n = CLng(Rnd(i) * Second(Now) * 100) Mod UBound(DataRange) + 1
                  If i <> n Then tmp = DataRange(n, 1):          DataRange(n, 1) = DataRange(i, 1):         DataRange(i, 1) = tmp
            Next i
            rg2.Resize(nData) = DataRange:            Set rg = Nothing:            Set rg2 = Nothing
End Sub

【讨论】：