Excel VBA, Копирование информации на другой лист, но со случайными именами - PullRequest
0 голосов
/ 16 мая 2018

У меня проблема с моей программой Excel. Я хочу сделать имена и номера телефонов для вставки на другом листе, но имена должны быть отсортированы случайным образом, и номера телефонов должны быть одинаковыми. Например, на первом листе у меня есть Калин Калинов +22222222 и Мартин Мартинов +99119911, а на другом листе после действия копирования и вставки они должны быть такими же, как Мартин Мартинов +99119911 и Калин Калинов +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  

Ответы [ 2 ]

0 голосов
/ 16 мая 2018
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
0 голосов
/ 16 мая 2018

Добавьте что-то вроде этого и примените его либо на исходном листе, либо на целевом листе:

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

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

Создает столбец случайных значений, используемый для сортировки. Возможно, вы захотите удалить его потом.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...