Добрый день. У меня вот такой вопрос. Есть книга в Excel2007, а в ней 2 листа. Как перенести данные из одного в другой при соблюдении условия- заполнять ячейки в соответствии с именами. Очень хотелось бы добиться этого через кнопочку.
Добрый день. У меня вот такой вопрос. Есть книга в Excel2007, а в ней 2 листа. Как перенести данные из одного в другой при соблюдении условия- заполнять ячейки в соответствии с именами. Очень хотелось бы добиться этого через кнопочку.Свирид
Свирид, не поясните "Не по чину поведение."? (Ваше снижение репутации)? в чём именно "не по чину"? чем не понравилось "поведение"? или Вы сегодня особенно дурак?
Свирид, не поясните "Не по чину поведение."? (Ваше снижение репутации)? в чём именно "не по чину"? чем не понравилось "поведение"? или Вы сегодня особенно дурак?ikki
помощь по Excel и VBA ikki@fxmail.ru, icq 592842413, skype alex.ikki
[offtop]Еще немного, и начнут санкции вводить (бесперспективное занятие)[/offtop] Свирид, попробуйте так [vba]
Код
Sub ertert() Dim x, y(), i& With Sheets("Премьер-лига") With .Range("C3", .Cells(Rows.Count, 3).End(xlUp)).Rows ReDim y(1 To .Count, 1 To .Count * 2) End With x = .Range("Z2").CurrentRegion.Value End With For i = 2 To UBound(x) y(x(i, 1), x(i, 4) * 2 - 1) = x(i, 2) y(x(i, 1), x(i, 4) * 2) = x(i, 3) Next i With Sheets("Шахматка") .Range("B2").Resize(UBound(y), UBound(y) * 2) = y() .Activate End With End Sub
[/vba]
[offtop]Еще немного, и начнут санкции вводить (бесперспективное занятие)[/offtop] Свирид, попробуйте так [vba]
Код
Sub ertert() Dim x, y(), i& With Sheets("Премьер-лига") With .Range("C3", .Cells(Rows.Count, 3).End(xlUp)).Rows ReDim y(1 To .Count, 1 To .Count * 2) End With x = .Range("Z2").CurrentRegion.Value End With For i = 2 To UBound(x) y(x(i, 1), x(i, 4) * 2 - 1) = x(i, 2) y(x(i, 1), x(i, 4) * 2) = x(i, 3) Next i With Sheets("Шахматка") .Range("B2").Resize(UBound(y), UBound(y) * 2) = y() .Activate End With End Sub
nilem, работает но только до первой попытки сменить координаты (изменить данные в выпадающих списках с названиев команд). В этом случае на втором листе данные не дополняются а меняют положение, тоесть заполненость таблицы не растёт а должна. Смысл в том чтобы данные попавшие на второй лист (лист Шахматка) там и оставались, в то время как данные на первом листе (лист Премьер-лига) будут меняться Спасибо за старания, очень ценю, но не то. Плюсик поставил
nilem, работает но только до первой попытки сменить координаты (изменить данные в выпадающих списках с названиев команд). В этом случае на втором листе данные не дополняются а меняют положение, тоесть заполненость таблицы не растёт а должна. Смысл в том чтобы данные попавшие на второй лист (лист Шахматка) там и оставались, в то время как данные на первом листе (лист Премьер-лига) будут меняться Спасибо за старания, очень ценю, но не то. Плюсик поставил Свирид
Сообщение отредактировал Свирид - Суббота, 09.08.2014, 18:28
Sub ertert() Dim x, y, i& x = Sheets("Премьер-лига").Range("Z2").CurrentRegion.Value With Sheets("Шахматка") With .Range("A1").CurrentRegion y = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count + 1).Value End With For i = 2 To UBound(x) y(x(i, 1), x(i, 4) * 2 - 1) = x(i, 2) y(x(i, 1), x(i, 4) * 2) = x(i, 3) Next i .Range("B2").Resize(UBound(y, 1), UBound(y, 2)) = y .Activate End With End Sub
[/vba]
тогда, наверное, так: [vba]
Код
Sub ertert() Dim x, y, i& x = Sheets("Премьер-лига").Range("Z2").CurrentRegion.Value With Sheets("Шахматка") With .Range("A1").CurrentRegion y = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count + 1).Value End With For i = 2 To UBound(x) y(x(i, 1), x(i, 4) * 2 - 1) = x(i, 2) y(x(i, 1), x(i, 4) * 2) = x(i, 3) Next i .Range("B2").Resize(UBound(y, 1), UBound(y, 2)) = y .Activate End With End Sub