Страницы: 1
RSS
Макрос для Рандомного текста, Макрос
 
Здравствуйте, не знаю как правильно писать макросы. Задачка такая есть 7 столбцов с разным текстом. Нужно что бы в 8-ом столбце были случайные вариации текста колонок

Есть такой вариант макроса но он не охватывает все столбцы

Sub Random()
 Dim r&, rn&, c&, s$
 Randomize: rn = Cells(Rows.Count, 1).End(xlUp).Row
 Columns(5).ClearContents
 r = 100 + Rnd * 100
 For r = 1 To r
   s = ""
   For c = 1 To 3
     s = s & Cells(1 + Int(Rnd * rn), c) & " "
   Next
   Cells(r, 5) = s
 Next
End Sub
Изменено: Вфьшфт Makarov - 30.08.2022 07:56:12
 
может как-то так... см. файл
 
Можно так: забрать в массив требуемый диапазон, затем "перемешать" этот массив в случайном порядке.
В данном случае поменять местами два произвольных элемента массива 1000 раз будет вполне достаточно.
Код
Function Randomize3(Rng As Range) As String
    Dim a(), i As Long, j As Long, k As Long, x
    a = Application.Index(Rng.Value, 1, 0)
    For k = 1 To 1000
        i = Int(1 + (UBound(a) * Rnd))
        j = Int(1 + (UBound(a) * Rnd))
        x = a(i): a(i) = a(j): a(j) = x
    Next
    Randomize3 = Join(a)
End Function
Пример во вложении.
Чем шире угол зрения, тем он тупее.
 
Цитата
написал:
может как-то так... см. файл
Есть такой вариант макроса но он не охватывает все столбцы

Sub Random()
 Dim r&, rn&, c&, s$
 Randomize: rn = Cells(Rows.Count, 1).End(xlUp).Row
 Columns(5).ClearContents
 r = 100 + Rnd * 100
 For r = 1 To r
   s = ""
   For c = 1 To 3
     s = s & Cells(1 + Int(Rnd * rn), c) & " "
   Next
   Cells(r, 5) = s
 Next
End Sub
 
Цитата
написал:
Можно так: забрать в массив требуемый диапазон, затем "перемешать" этот массив в случайном порядке.
В данном случае поменять местами два произвольных элемента массива 1000 раз будет вполне достаточно.
Код
    [URL=#]?[/URL]       1  2  3  4  5  6  7  8  9  10      Function   Randomize3(Rng   As   Range)   As   String          Dim   a(), i   As   Long  , j   As   Long  , k   As   Long  , x          a = Application.Index(Rng.Value, 1, 0)          For   k = 1   To   1000              i = Int(1 + (UBound(a) * Rnd))              j = Int(1 + (UBound(a) * Rnd))              x = a(i): a(i) = a(j): a(j) = x          Next          Randomize3 = Join(a)    End   Function   
  Пример во вложении.
Этот макрос работает как нужно но он не охватывает все столбцы

Sub Random()
 Dim r&, rn&, c&, s$
 Randomize: rn = Cells(Rows.Count, 1).End(xlUp).Row
 Columns(5).ClearContents
 r = 100 + Rnd * 100
 For r = 1 To r
   s = ""
   For c = 1 To 3
     s = s & Cells(1 + Int(Rnd * rn), c) & " "
   Next
   Cells(r, 5) = s
 Next
End Sub
 
В постах №2 и №3 Вам были предложены пользовательские функции, которые применялись на рабочем листе.
Если нужен именно макрос, то можно так:
Код
Sub Random()
    Dim i As Long: Application.ScreenUpdating = False
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        Cells(i, "H") = Randomize3(Cells(i, 1).Resize(, 7))
    Next
End Sub

Function Randomize3(Rng As Range) As String
    Dim a(), i As Long, j As Long, k As Long, x
    a = Application.Index(Rng.Value, 1, 0)
    For k = 1 To 1000
        i = Int(1 + (UBound(a) * Rnd))
        j = Int(1 + (UBound(a) * Rnd))
        x = a(i): a(i) = a(j): a(j) = x
    Next
    Randomize3 = Join(a)
End Function
Откройте прикрепленный файл и выполните макрос "Random".
В результате, в столбце "H" каждой строки в пределах рабочего диапазона (который определяется по последней заполненной строке в столбце "A") будет "смесь" из всех значений столбцов "A:G" этой строки.
Если Вам нужно что-то другое - опишите подробнее. Не экономьте слова.
Чем шире угол зрения, тем он тупее.
Страницы: 1
Наверх