Question

我的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

Answer 1

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

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

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

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

Answer 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

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

2 个答案: