Создание цикла переноса столбцов - Microsoft Office Excel

Keshunya · 07.12.2010, 12:09

Прошу помощи, т.к. устала биться рыбой об лед, не мой видно еще уровень. Подскажите, пжл., как создать столбец сведенных данных с кодом цикла (потому как размер макроса поражает мое воображение - столбцы еще не все взяла, лист прикладываю 1, а у меня их 10-ток). Меня бы только на мысль натолкнуть, много не обещаю, а "спасибо" точно заработаете. Удачного всем дня и плодотворной работы!

Keshunya · 07.12.2010, 12:34

Создавала код макрорекордером, массивище получился:
Макрос1 Макрос
' Копирование ячеек
' Range("C23").Select
ActiveWindow.SmallScroll Down:=-9
Selection.Copy
Application.CutCopyMode = False
Range("C6:C13").Select
Selection.Copy
Range("C22").Select
ActiveSheet.Paste
Range("D6:D13").Select
Application.CutCopyMode = False
Selection.Copy
Range("C30").Select
ActiveSheet.Paste
Range("E6:E13").Select
Application.CutCopyMode = False
Selection.Copy
Range("C38").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=0
Range("F6:F13").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=9
Range("C46").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=-15
Range("G6:G13").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=24
Range("C54").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=-54
Range("C21:C63").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("C21"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveWindow.SmallScroll Down:=-45
End Sub
Ну зачем такой "головняк"? Может циклом, или что еще можно попробовать?

IgorGO · 07.12.2010, 12:48

данные не смотрел, читал макрос, попробуйте это:

Код:

Sub Mac1()
  For i = 1 To 5
    Range(Cells(6, i + 2), Cells(13, i + 2)).Copy Destination:=Cells(14 + i * 8, 3)
  Next
  Range("C21:C63").Sort Key1:=Range("C21"), Order1:=xlAscending, Header:=xlGuess, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End Sub

VictorM · 07.12.2010, 12:50

Специально не делал никаких циклов, просто подправил Ваш макрос.

Код:

Sub Макрос1()
    Range("C6:C13").Copy Range("C22")
    Range("D6:D13").Copy Range("C30")
    Range("E6:E13").Copy Range("C38")
    Range("F6:F13").Copy Range("C46")
    Range("G6:G13").Copy Range("C54")
    Range("C21:C63").Sort Key1:=Range("C21"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End Sub

Keshunya · 07.12.2010, 13:00

Спасибо огромное! Оба варианта подходят, дальше допишу под себя! Здоровья Вам и Вашим семьям!

07.12.2010, 12:48	#3
IgorGO Новичок СтарожилДжуниор Регистрация: 05.02.2008 Сообщений: 9,487	данные не смотрел, читал макрос, попробуйте это: Код: `Sub Mac1() For i = 1 To 5 Range(Cells(6, i + 2), Cells(13, i + 2)).Copy Destination:=Cells(14 + i * 8, 3) Next Range("C21:C63").Sort Key1:=Range("C21"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal End Sub` Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете

07.12.2010, 12:50	#4
VictorM Старожил Регистрация: 15.05.2008 Сообщений: 2,058	Специально не делал никаких циклов, просто подправил Ваш макрос. Код: `Sub Макрос1() Range("C6:C13").Copy Range("C22") Range("D6:D13").Copy Range("C30") Range("E6:E13").Copy Range("C38") Range("F6:F13").Copy Range("C46") Range("G6:G13").Copy Range("C54") Range("C21:C63").Sort Key1:=Range("C21"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal End Sub` "Дайте людям рыбы, и вы накормите их на весь день; научите их ловить рыбу - и вы накормите их на всю жизнь" "Большое спасибо" - Z261597841314, R208907249777, U447361470499

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Создание цикла переноса данных из одного диапозона в другой	Freerider1972	Microsoft Office Excel	7	30.10.2010 22:15
Создание цикла в Access	NickiBell	Помощь студентам	1	17.09.2010 12:10
Создание цикла	LENA_M	Microsoft Office Excel	2	23.06.2009 11:19
Переход от цикла к циклу не выходя из цикла (без multithreading)	Qousio	Общие вопросы C/C++	2	16.05.2009 09:27
Создание цикла.	lexusus	Общие вопросы C/C++	6	27.05.2008 17:38

07.12.2010, 12:34	#2
Keshunya Пользователь Регистрация: 08.07.2010 Сообщений: 33	Создавала код макрорекордером, массивище получился: Макрос1 Макрос ' Копирование ячеек ' Range("C23").Select ActiveWindow.SmallScroll Down:=-9 Selection.Copy Application.CutCopyMode = False Range("C6:C13").Select Selection.Copy Range("C22").Select ActiveSheet.Paste Range("D6:D13").Select Application.CutCopyMode = False Selection.Copy Range("C30").Select ActiveSheet.Paste Range("E6:E13").Select Application.CutCopyMode = False Selection.Copy Range("C38").Select ActiveSheet.Paste ActiveWindow.SmallScroll Down:=0 Range("F6:F13").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll Down:=9 Range("C46").Select ActiveSheet.Paste ActiveWindow.SmallScroll Down:=-15 Range("G6:G13").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll Down:=24 Range("C54").Select ActiveSheet.Paste ActiveWindow.SmallScroll Down:=-54 Range("C21:C63").Select Application.CutCopyMode = False Selection.Sort Key1:=Range("C21"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal ActiveWindow.SmallScroll Down:=-45 End Sub Ну зачем такой "головняк"? Может циклом, или что еще можно попробовать?

07.12.2010, 13:00	#5
Keshunya Пользователь Регистрация: 08.07.2010 Сообщений: 33	Спасибо огромное! Оба варианта подходят, дальше допишу под себя! Здоровья Вам и Вашим семьям!