Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Составить список перелинковки по рандому - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Составить список перелинковки по рандому (Макросы/Sub)
Составить список перелинковки по рандому
nikfedorov Дата: Среда, 09.05.2018, 11:08 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Добрый день, уважаемые знатоки VB!
Вот для вас задачка, которая не составит сложности в отличие от меня :)



Есть база значений, нужно в первой колонке продублировать 7 раз значение из базы, во второй колонке 7 раз по рандому вставить следующие значения, но за исключением первого. И далее следующее. (Значения не обязательно отличаются по порядку, как 01.. 02.. бывает 34393 затем 34507 ).

Это мой новый список, который я хотел бы уже куда-то вставить и получить на выходе 7 первых значений в каждой строке, напротив которых рандомное значение за исключением текущего. И далее следующее значение.
К сообщению приложен файл: rand.xlsx (10.0 Kb)


Сообщение отредактировал nikfedorov - Среда, 09.05.2018, 11:09
 
Ответить
СообщениеДобрый день, уважаемые знатоки VB!
Вот для вас задачка, которая не составит сложности в отличие от меня :)



Есть база значений, нужно в первой колонке продублировать 7 раз значение из базы, во второй колонке 7 раз по рандому вставить следующие значения, но за исключением первого. И далее следующее. (Значения не обязательно отличаются по порядку, как 01.. 02.. бывает 34393 затем 34507 ).

Это мой новый список, который я хотел бы уже куда-то вставить и получить на выходе 7 первых значений в каждой строке, напротив которых рандомное значение за исключением текущего. И далее следующее значение.

Автор - nikfedorov
Дата добавления - 09.05.2018 в 11:08
Roman777 Дата: Среда, 09.05.2018, 18:20 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
nikfedorov,
Такое надо?
[vba]
Код
Sub rand()
    Dim o() As String
    Dim i As Long, j As Long
    Dim n As Long, k As Long
    Dim numb As Long
    Dim a
    a = Range(cells(1, 1), cells(18, 1))
    n = UBound(a, 1)
    ReDim o(n)
    For i = 1 To n
        o(i) = a(i, 1)
    Next i
    Dim o1() As String
    ReDim o1(n - 1)
    For i = 1 To n
        k = 0
        For j = 1 To n
            If (j <> i) Then
                k = k + 1
                o1(k) = o(j)
            End If
        Next j
        For j = 1 To 7
            cells((i - 1) * 7 + j, 5) = o(i)
            Randomize
            numb = Int((n - 1) * rnd()) + 1
            cells((i - 1) * 7 + j, 6) = o1(numb)
        Next j
    Next i
End Sub
[/vba]


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Среда, 09.05.2018, 18:22
 
Ответить
Сообщениеnikfedorov,
Такое надо?
[vba]
Код
Sub rand()
    Dim o() As String
    Dim i As Long, j As Long
    Dim n As Long, k As Long
    Dim numb As Long
    Dim a
    a = Range(cells(1, 1), cells(18, 1))
    n = UBound(a, 1)
    ReDim o(n)
    For i = 1 To n
        o(i) = a(i, 1)
    Next i
    Dim o1() As String
    ReDim o1(n - 1)
    For i = 1 To n
        k = 0
        For j = 1 To n
            If (j <> i) Then
                k = k + 1
                o1(k) = o(j)
            End If
        Next j
        For j = 1 To 7
            cells((i - 1) * 7 + j, 5) = o(i)
            Randomize
            numb = Int((n - 1) * rnd()) + 1
            cells((i - 1) * 7 + j, 6) = o1(numb)
        Next j
    Next i
End Sub
[/vba]

Автор - Roman777
Дата добавления - 09.05.2018 в 18:20
nikfedorov Дата: Среда, 09.05.2018, 19:05 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Супер! Не знаю даже как вас благодарить.
 
Ответить
СообщениеСупер! Не знаю даже как вас благодарить.

Автор - nikfedorov
Дата добавления - 09.05.2018 в 19:05
nikfedorov Дата: Среда, 09.05.2018, 20:52 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Если это не будет большой наглостью с моей стороны, можете сделать более гибкое решение?
В следующий раз я могу получить 5 или 50 строк значений для перелинковки.
Если бы макрос шел по столбику пока он не закончится (или как-то понимал, что сегодня 4 строки, вместо прошлых 20ти) - будет супер! :)
 
Ответить
СообщениеЕсли это не будет большой наглостью с моей стороны, можете сделать более гибкое решение?
В следующий раз я могу получить 5 или 50 строк значений для перелинковки.
Если бы макрос шел по столбику пока он не закончится (или как-то понимал, что сегодня 4 строки, вместо прошлых 20ти) - будет супер! :)

Автор - nikfedorov
Дата добавления - 09.05.2018 в 20:52
Roman777 Дата: Среда, 09.05.2018, 21:06 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Возможно, понял, о чем речь:
[vba]
Код
Sub rand()
    Dim o() As String
    Dim i As Long, j As Long
    Dim n As Long, k As Long
    Dim numb As Long
    Dim a
    a = Range(cells(1, 1), cells(cells(rows.count,1).end(xlUp).row, 1))
    n = UBound(a, 1)
    ReDim o(n)
    For i = 1 To n
        o(i) = a(i, 1)
    Next i
    Dim o1() As String
    ReDim o1(n - 1)
    For i = 1 To n
        k = 0
        For j = 1 To n
            If (j <> i) Then
                k = k + 1
                o1(k) = o(j)
            End If
        Next j
        For j = 1 To 7
            cells((i - 1) * 7 + j, 5) = o(i)
            Randomize
            numb = Int((n - 1) * rnd()) + 1
            cells((i - 1) * 7 + j, 6) = o1(numb)
        Next j
    Next i
End Sub
[/vba]


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Среда, 09.05.2018, 21:06
 
Ответить
СообщениеВозможно, понял, о чем речь:
[vba]
Код
Sub rand()
    Dim o() As String
    Dim i As Long, j As Long
    Dim n As Long, k As Long
    Dim numb As Long
    Dim a
    a = Range(cells(1, 1), cells(cells(rows.count,1).end(xlUp).row, 1))
    n = UBound(a, 1)
    ReDim o(n)
    For i = 1 To n
        o(i) = a(i, 1)
    Next i
    Dim o1() As String
    ReDim o1(n - 1)
    For i = 1 To n
        k = 0
        For j = 1 To n
            If (j <> i) Then
                k = k + 1
                o1(k) = o(j)
            End If
        Next j
        For j = 1 To 7
            cells((i - 1) * 7 + j, 5) = o(i)
            Randomize
            numb = Int((n - 1) * rnd()) + 1
            cells((i - 1) * 7 + j, 6) = o1(numb)
        Next j
    Next i
End Sub
[/vba]

Автор - Roman777
Дата добавления - 09.05.2018 в 21:06
nikfedorov Дата: Среда, 09.05.2018, 21:25 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Великолепно, спасибо большое!
 
Ответить
СообщениеВеликолепно, спасибо большое!

Автор - nikfedorov
Дата добавления - 09.05.2018 в 21:25
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Составить список перелинковки по рандому (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!