|
Компьютерный форум OSzone.net » Сфера Microsoft » Microsoft Office (Word, Excel, Outlook и т.д.) » 2007 - [решено] автоматизация переструктурирования данных |
|
2007 - [решено] автоматизация переструктурирования данных
|
Новый участник Сообщения: 11 |
Профиль | Отправить PM | Цитировать
Здравствуйте, помогите пожалуйста, мне облегчить задачу. Вот здесь эксель файл:
Тут мы видим, что у нас есть 7 переменных: x1-x7,желтое поле и для каждой переменной после него есть 3 переменных. Например, для переменной Х1, есть 3 переменных х1,х1,х1 для переменной Х2, есть 3 переменных х2,х2,х2. и так далее. Для образца я просто написал для 4х переменных. Нужно переструктурировать данные. Сначала идет желтое поле (сколько бы колонок в нем не было) - потом- переменная х1-а потом ровно 3 переменных x1,x1,x1 затем тоже самое. желтое поле(оно всегад статично)-переменная х2- и за ней 3 переменных x2, x2,x2. Переменных у меня сотни в работе, но есть строгий порядок их следования, его нельзя нарушать. Кому нетрудно помогите написать макрос, который эту механическую работу облегчает. |
|
Отправлено: 15:50, 02-10-2015 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать 1. Область данных так и будет всегда начинаться с «B1»?
2. Количество переменных всегда будет равно семи? 3. «и для каждой переменной…» — всегда будет присутствовать для каждой? 4. «…после него есть 3 переменных» — всегда равно трём? 5. «Сначала идет желтое поле (сколько бы колонок в нем не было)» — «жёлтое поле» всегда будет присутствовать? 6. Что за непонятные значения ячеек «лист1», «лист2»? Что за заголовок столбца «ч3»? 7. «затем тоже самое.» — между предыдущим и последующим «тем же самым» интервал должен быть именно три столбца? 8. Имена «переменных» будут именно «x1»…, «y»? Цитата golovatov:
|
|
Отправлено: 01:22, 03-10-2015 | #2 |
Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети. Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля. |
Новый участник Сообщения: 11
|
Профиль | Отправить PM | Цитировать здравствуйте,Iska.
Цитата Iska:
Цитата Iska:
тогда нетрудно подсчитать, что если 1000 переменных, то после желтого поля будет 3 000 столбцов. Я думаю Вы поняли Цитата Iska:
если есть x1000, то для нее будет три x1000 x1000 x1000 Цитата Iska:
Цитата Iska:
лист1, лист2, просто попытался разделить, ну, т.е. чтобы вот так на выходи были данные. Цитата Iska:
x1 -x1x1x1 x2-x2x2x2 Цитата Iska:
это я как шаблон привел. Названия всегда будут в первой строке. Цитата Iska:
Но это просто как шаблон. |
||||||||
Отправлено: 12:05, 03-10-2015 | #3 |
Динохромный Сообщения: 690
|
Профиль | Отправить PM | Цитировать golovatov, попробуйте такой код:
Код
Public Sub table_sort() Dim dataSht As Worksheet, newSht As Worksheet Dim objCell As Range, DataRange As Range Dim i As Integer, i1 As Integer, i2 As Integer, j As Integer, k As Integer Set dataSht = ActiveWorkbook.ActiveSheet Set DataRange = dataSht.UsedRange For i = DataRange.Column To DataRange.Column + DataRange.Columns.Count - 1 If dataSht.Cells(DataRange.Row, i).Interior.Color = 65535 Then If i1 = 0 Then i1 = i Else i2 = i End If Next i For k = i1 - 1 To DataRange.Column Step -1 If Intersect(dataSht.Columns(k), DataRange.Rows(1)).Value <> "" Then Range(Rows(DataRange.Rows.Count + 2), Rows(2 * DataRange.Rows.Count + 2)).EntireRow.Insert Intersect(DataRange, Range(Columns(i1), Columns(i2)).EntireColumn).Copy Cells(DataRange.Rows.Count + 3, 1).Select ActiveSheet.Paste Intersect(DataRange, Range(Columns(k), Columns(k)).EntireColumn).Copy ActiveCell.Offset(0, i2 - i1 + 1).Select ActiveSheet.Paste For j = i2 + 1 To DataRange.Columns.Count If dataSht.Cells(1, j).Value = ActiveCell.Value And dataSht.Cells(1, j).Value = dataSht.Cells(1, j + 1).Value And dataSht.Cells(1, j).Value = dataSht.Cells(1, j + 2).Value Then ActiveCell.Offset(0, 1).Select Intersect(DataRange, Range(Columns(j), Columns(j + 2)).EntireColumn).Copy ActiveSheet.Paste Exit For End If Next j End If Next k Set DataRange = Nothing Set dataSht = Nothing End Sub Оговорки: кроме исходной таблицы на листе не должно ничего быть. Если название переменных Хi и хi,хi,хi не совпадают с положенным им Вами местом - сознательно копировать не будет, так как нарушена указанная Вами структура данных, т.е. останется пустое место. Заголовки должны находиться в первой строке. не могу сказать, что VBA мой конек, сначала потестируйте на правильность работы с разными наборами данных. |
Отправлено: 18:52, 05-10-2015 | #4 |
Динохромный Сообщения: 690
|
Профиль | Отправить PM | Цитировать golovatov, учитывая озвученные Вами требования по несовпадению названий переменных Хi и xi,xi,xi код изменится следующим образом:
код
Public Sub table_sort() Dim dataSht As Worksheet, newSht As Worksheet Dim objCell As Range, DataRange As Range Dim i As Integer, i1 As Integer, i2 As Integer, j As Integer, k As Integer Set dataSht = ActiveWorkbook.ActiveSheet Set DataRange = dataSht.UsedRange For i = DataRange.Column To DataRange.Column + DataRange.Columns.Count - 1 If dataSht.Cells(DataRange.Row, i).Interior.Color = 65535 Then If i1 = 0 Then i1 = i Else i2 = i End If Next i For k = i1 - 1 To DataRange.Column Step -1 If Intersect(dataSht.Columns(k), DataRange.Rows(1)).Value <> "" Then Range(Rows(DataRange.Rows.Count + 2), Rows(2 * DataRange.Rows.Count + 2)).EntireRow.Insert Intersect(DataRange, Range(Columns(i1), Columns(i2)).EntireColumn).Copy Cells(DataRange.Rows.Count + 3, 1).Select ActiveSheet.Paste Intersect(DataRange, Range(Columns(k), Columns(k)).EntireColumn).Copy ActiveCell.Offset(0, i2 - i1 + 1).Select ActiveSheet.Paste For j = i2 + 1 To DataRange.Columns.Count If Right(dataSht.Cells(1, j).Value, Len(ActiveCell.Value)) = ActiveCell.Value And Right(dataSht.Cells(1, j + 1).Value, Len(ActiveCell.Value)) = ActiveCell.Value And Right(dataSht.Cells(1, j + 2).Value, Len(ActiveCell.Value)) = ActiveCell.Value Then ActiveCell.Offset(0, 1).Select Intersect(DataRange, Range(Columns(j), Columns(j + 2)).EntireColumn).Copy ActiveSheet.Paste Exit For End If Next j End If Next k Set DataRange = Nothing Set dataSht = Nothing End Sub |
|
------- Отправлено: 12:20, 06-10-2015 | #5 |
Участник сейчас на форуме | Участник вне форума | Автор темы | Сообщение прикреплено |
| |||||
Название темы | Автор | Информация о форуме | Ответов | Последнее сообщение | |
V. 2010 - Удаление недоступной базы данных и сервера баз данных Exchange | jayboun | Microsoft Exchange Server | 0 | 10-11-2014 14:57 | |
Автоматизация | Rezor666 | Хочу все знать | 13 | 26-03-2012 10:19 | |
2010 - Автоматизация ввода данных в документе Word 2010. Как? | Gowdin | Microsoft Office (Word, Excel, Outlook и т.д.) | 7 | 14-02-2012 05:33 | |
Ошибка - Проблема с восстановлением данных в мастере переноса данных | barbarbar | Microsoft Windows 2000/XP | 1 | 13-02-2010 10:51 | |
MySQL - [решено] сохранение данных в базе данных Mysql | TigerZaka | Программирование и базы данных | 4 | 24-08-2008 15:48 |
|