Здравствуйте. Нужно реализовать следующее: На листе2 имеются ячейки А1-А10 с произвольным текстом. Нужно сделать, чтобы в ячейки А1,А2,А3 листа1 выводился случайным образом текст из А1-А10 листа2. Еще нужна возможность (кнопка или еще как) этот текст обновлять, если предложенный вариант вывода не понравился.
Также необходим случайный вывод текста из А1-А10 листа2 в текстовое поле к цифрам 1., 2., 3. (может проще вывод к цифрам сделать вместо букв а,б,в?). Если я задал два разных вопроса (не хотелось плодить темы), то в приоритете вывод в текстовое поле.
Здравствуйте. Нужно реализовать следующее: На листе2 имеются ячейки А1-А10 с произвольным текстом. Нужно сделать, чтобы в ячейки А1,А2,А3 листа1 выводился случайным образом текст из А1-А10 листа2. Еще нужна возможность (кнопка или еще как) этот текст обновлять, если предложенный вариант вывода не понравился.
Также необходим случайный вывод текста из А1-А10 листа2 в текстовое поле к цифрам 1., 2., 3. (может проще вывод к цифрам сделать вместо букв а,б,в?). Если я задал два разных вопроса (не хотелось плодить темы), то в приоритете вывод в текстовое поле.kvlar
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) aa = Target.Column ab = Target.Row 'a = Cells(Rows.Count, "a").End(xlUp).Row a = 3 If aa = 1 And ab <= a Then Cancel = True Application.ScreenUpdating = False 'b = Sheets("Лист2").Cells(Rows.Count, "a").End(xlUp).Row b = 10 'f = b - a f = 7 h = Application.RandBetween(1, f) 'k = Application.Match(h, Sheets("Лист2").Range("b1:b10"), 0) k = Application.Match(h, Sheets("Лист2").Range("b1:b" & b), 0) Range("a" & ab) = Sheets("Лист2").Range("a" & k).Value j = "" d = "" For i = 1 To a c = Range("a" & i).Value If i > 1 Then d = Chr(13) j = j & d & i & ". " & c Next With ActiveSheet.Shapes.Range(Array("TextBox 1")) .TextFrame2.TextRange.Characters.Text = j End With Application.ScreenUpdating = True End If End Sub
[/vba]двойной клик по ячейкам A1:A3 Листа1
Лист2 A1
Код
=ЕСЛИ(ЕНД(ПОИСКПОЗ(A1;Лист1!A:A;));1;)
A2:A10
Код
=ЕСЛИ(ЕНД(ПОИСКПОЗ(A2;Лист1!A:A;));B1+1;B1)
Лист1 Модуль [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) aa = Target.Column ab = Target.Row 'a = Cells(Rows.Count, "a").End(xlUp).Row a = 3 If aa = 1 And ab <= a Then Cancel = True Application.ScreenUpdating = False 'b = Sheets("Лист2").Cells(Rows.Count, "a").End(xlUp).Row b = 10 'f = b - a f = 7 h = Application.RandBetween(1, f) 'k = Application.Match(h, Sheets("Лист2").Range("b1:b10"), 0) k = Application.Match(h, Sheets("Лист2").Range("b1:b" & b), 0) Range("a" & ab) = Sheets("Лист2").Range("a" & k).Value j = "" d = "" For i = 1 To a c = Range("a" & i).Value If i > 1 Then d = Chr(13) j = j & d & i & ". " & c Next With ActiveSheet.Shapes.Range(Array("TextBox 1")) .TextFrame2.TextRange.Characters.Text = j End With Application.ScreenUpdating = True End If End Sub