|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
03.12.2018, 00:35 | #1 |
Регистрация: 16.10.2018
Сообщений: 6
|
перенос значений в таблицу (VBA)
Добрый день, Нужен макрос где будет создавать цикл который ищет основные данные на листе в каждой строке: Имя пользователя,Действие,Тип объекта,Имя объекта,Временная ,Поле,Старое значение,Новое значение
И переносит на новый лист в виде 8 столбцовой таблицы с каждым из этих значений и по окончанию всех значений на листе прерывает цикл Заранее Спасибо |
03.12.2018, 17:16 | #2 |
Пользователь
Регистрация: 03.12.2018
Сообщений: 77
|
Не совсем понятна задача. Что, из строки явлется Полем, Старым значением, новым значением?
|
03.12.2018, 23:28 | #3 |
Регистрация: 16.10.2018
Сообщений: 6
|
Вот должно получиться вот так из того что я скинул первым, за счет запуска макроса
поле где agent, старое значение пустое а новое где 6 и primary Последний раз редактировалось Влад1952; 03.12.2018 в 23:31. |
04.12.2018, 08:36 | #4 |
Пользователь
Регистрация: 03.12.2018
Сообщений: 77
|
Ясно. Можете выложить Excel, я в нём сразу напишу макрос. Так будет проще
|
04.12.2018, 08:58 | #5 |
Регистрация: 16.10.2018
Сообщений: 6
|
конечно
|
04.12.2018, 11:57 | #6 |
Пользователь
Регистрация: 03.12.2018
Сообщений: 77
|
Как-то так
Sub Разбивка()
Application.ScreenUpdating = False NameSh = ActiveSheet.Name EndMass = Cells.End(xlDown).Row Sheets.Add.Name = "Разбивка" rRow = 1 For CurRow = 5 To EndMass CurRec = Sheets(NameSh).Cells(CurRow, 1) If Left(CurRec, 5) = ",,Имя" Then Sheets("Разбивка").Cells(rRow, 1) = "Имя пользователя" Sheets("Разбивка").Cells(rRow, 5) = "Действие" Sheets("Разбивка").Cells(rRow, 8) = "Тип объекта" Sheets("Разбивка").Cells(rRow, 9) = "Имя объекта" Sheets("Разбивка").Cells(rRow, 11) = "Временная" rRow = rRow + 1 End If If Left(CurRec, 9) = ",,СИСТЕМА" Then Sheets("Разбивка").Cells(rRow, 1) = "СИСТЕМА" Sheets("Разбивка").Cells(rRow, 5) = "Обновить" Sheets("Разбивка").Cells(rRow, 8) = "Agent" ff = InStr(1, """", CurRec) Sheets("Разбивка").Cells(rRow, 9) = CurRec Sheets("Разбивка").Cells(rRow, 9).Replace What:="*,""", Replacement:="", LookAt:=xlPart Sheets("Разбивка").Cells(rRow, 9).Replace What:=""",*", Replacement:="", LookAt:=xlPart Sheets("Разбивка").Cells(rRow, 11) = Replace(Right(CurRec, 16), ",", "") Sheets("Разбивка").Cells(rRow + 1, 2) = "Поле" Sheets("Разбивка").Cells(rRow + 1, 6) = "Старое значение" Sheets("Разбивка").Cells(rRow + 1, 10) = "Новое значение" rRow = rRow + 2 For aCurRow = CurRow + 2 To EndMass aCurRec = Sheets(NameSh).Cells(aCurRow, 1) If Left(aCurRec, 13) = ",,,,,,,,,,,,," Then Exit For Sheets("Разбивка").Cells(rRow, 2) = aCurRec Sheets("Разбивка").Cells(rRow, 2).Replace What:="*,""", Replacement:="", LookAt:=xlPart Sheets("Разбивка").Cells(rRow, 2).Replace What:=""",*", Replacement:="", LookAt:=xlPart Sheets("Разбивка").Cells(rRow, 10) = Replace(Right(aCurRec, 12), ",", "") rRow = rRow + 1 Next aCurRow End If Next CurRow Application.ScreenUpdating = True End Sub |
04.12.2018, 12:05 | #7 |
Регистрация: 16.10.2018
Сообщений: 6
|
Спасибо огромное
|
04.12.2018, 12:16 | #8 |
Пользователь
Регистрация: 03.12.2018
Сообщений: 77
|
Не сразу видел, там ещё не все варианты отработаны (
Вечерком ещё раз могу пройтись по коду |
04.12.2018, 19:15 | #9 |
Регистрация: 16.10.2018
Сообщений: 6
|
если не трудно
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
перенос данных в таблицу | Elli9 | Microsoft Office Excel | 0 | 26.02.2018 16:14 |
Перенос значений таблиц из Excel в несколько таблиц Word средствами VBA | apfu00 | Microsoft Office Excel | 0 | 19.10.2016 16:51 |
Перенос данных из формы в таблицу | Enero | Microsoft Office Access | 1 | 08.08.2014 08:20 |
В задаче необходимо вывести на экран таблицу значений функции У(х) и ее разложения в ряд С (х) для значений х от до с шагом.(Паск | fashionweek | Паскаль, Turbo Pascal, PascalABC.NET | 1 | 07.02.2013 23:11 |
Отбор нескольких значений и перенос в другую таблицу | unfit | Microsoft Office Excel | 3 | 23.02.2012 07:16 |