Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Макросы вырезать вставить
 
#1
13.07.2011 12:55:17
Помогите пожалуйста. Необходимо вырезать две ячейки и вставить их в ячейки правее верхней строки. макрос получился вот такой, но не знаю как сделать применение макроса ко всей таблице. Подскажите чего не хватает.  
 
Range("N31:O31").Select  
   Selection.Cut  
   Range("P30").Select  
   ActiveSheet.Paste  
   Range("N33:O33").Select  
   Selection.Cut  
   Range("P32").Select  
   ActiveSheet.Paste  
End Sub
 
 
 
#2
13.07.2011 13:04:16
Примера таблицы в формате XLS не хватает.  
Откуда нам знать, с какой строки начинать перенос ячеек, на какой строке заканчивать, и с каким шагом это делать...
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#3
13.07.2011 13:04:43
Очень понравилось: "... и вставить их в ячейки правее верхней строки". Объясните как это ? А лучше дайте пример.
Редко но метко ...
 
 
 
#4
13.07.2011 13:07:35
зачем Вам макрос? На панели Форматирование, есть все необходимые кнопки
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#5
13.07.2011 13:11:58
да, "...вставить их в ячейки правее верхней строки" мне тоже понравилось :)
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
 
 
#6
13.07.2011 13:12:25
Вот приложил файл. Слева колонка как есть, справа как надо. Таблица очень огромная кроме как с макросами спастись не знаю.  
 
Огромнейшее спасибо за помощь.
 
 
 
#7
13.07.2011 13:16:55
Че то хрень какая то присоединилась. Сюда скопирую надеюсь поймете.  
 
1 й  
2 ц  
3 у  
4 к  
5 е  
6 н  
7 г  
 
в общем  строки 3, 4 надо скопировать в строки 1, 2. и так на всю таблицу  
 
1 й 3 у  
2 ц 4 к  
 
 
5 е 7 г  
6 н 8 ш
 
 
 
#8
13.07.2011 13:21:52
Вариант от Hugo  
sub tt()  
dim lRow as long, i as long  
application.ScreenUpdating = false  
lRow = Cells(Rows.Count, 2).End(xlUp).Row  
for i = lRow to 3 step -2  
range(cells(i, "B"),cells(i,"C")).copy cells(i-1,"D")  
Rows(i).EntireRow.Delete  
next i  
end sub  
Для понимания решения почитайте по ссылке  
http://programmersforum.ru/showthread.php?t=159485
 
 
 
#9
13.07.2011 13:26:54
Sub test()  
   Dim r  
   r = 3  
   While r < Cells(Rows.Count, 1).End(xlUp).Row  
       Range("A" & r & ":B" & r + 1).Cut Destination:=Range("C" & r - 2 & ":D" & r - 1)  
       r = r + 4  
   Wend  
End Sub
 
 
 
#10
13.07.2011 13:37:40
попробуйте так  
 
Sub io()  
Dim objCell As Object  
For Each objCell In UsedRange.Columns(1).Cells  
   With objCell  
       If .Row Mod 4 = 0 Then  
           Range(.Address, .Offset(-1, 1).Address).Copy .Offset(-3, 5)  
           Range(.Offset(-3).Address, .Offset(-2, 1).Address).Copy .Offset(-3, 3)  
       End If  
   End With  
Next  
End Sub
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#11
13.07.2011 13:44:35
еще вариант
Редко но метко ...
 
 
 
Страницы: 1
Читают тему
Наверх