#excel #vba
Вопрос:
У меня есть большая электронная таблица данных, которая не выровнена. Этот лист предназначен для сравнения данных из двух отдельных источников в зависимости от даты их возникновения. Показания немного отличаются, поэтому в течение всех строк наблюдается несоосность.
Даты указаны в колонке А для первого чтения и колонке D для второго чтения. если дата в С другой стороны, если A > D, то мне нужно вставить новую строку выше и переместить данные из A, B и C в новую строку. В последнем случае, если даты правильно совпадают, мне нужно отформатировать столбец F, чтобы сказать «Да» и позеленеть. Эта последняя часть прекрасна, это разделы с A < D и A > D, с которыми я борюсь.
У меня такое чувство , что я использовал EntireRow.Insert Shift:= xlShiftDown
, но это, похоже, создает проблемы, так как я работаю только с 32-разрядной версией Excel.
ИЗМЕНИТЬ: VBA необходимо переместить все данные на одну строку вверх в зависимости от условия, так как метод копирования и вставки-это только половина проблемы. Этот скрипт будет использоваться для выравнивания дат. Вот небольшая выборка моих данных и то, что нужно сделать VBA.
И вот как я хочу, чтобы это выглядело:
На втором изображении я переместил данные вручную следующим образом, если дата в (A,1) > (D,1), я вставил новую строку, вырезал значения из (D:E,1) и вставил их в D:E новой строки. Затем я выбрал все данные ниже в колонках D и E и перетащил их на 1 ячейку вверх, чтобы выровнять. если А
(обратите внимание, надеюсь, что фотографии появятся, там написано, что я не могу вставить изображения, так что пока это просто ссылка)
Редактировать V2: Вот код PQ, который был скопирован из ответа Рона и вставлен в мой расширенный редактор PQ. Проблема в том, что Expression.Error: A join operation cannot result in a table with duplicate column names ("Date 1"). Details: [Type]
мои текущие заголовки в данных в точности соответствуют тем, которые можно увидеть на предыдущих скриншотах, поэтому теоретически это должно быть прямое копирование и вставка. Я подозреваю, что случайно изменил что-то в коде, изменив имя таблицы на справочное. Код, приведенный ниже:
let
//Read in the two tables
//Be sure to change names in Source lines to actual table names in your workbook
//add index column to TableA to enable replace dups with nulls
Source = Excel.CurrentWorkbook(){[Name="Table11"]}[Content],
TableA = Table.TransformColumnTypes(Source,{{"Date 1", type date}, {"Value", type number}, {"Value 2 (Src 1)", type number}}),
#"Added Index" = Table.AddIndexColumn(TableA, "Index", 0, 1, Int64.Type),
Source2 = Excel.CurrentWorkbook(){[Name="Table11"]}[Content],
TableB = Table.TransformColumnTypes(Source2,{{"Date 2", type date}, {"Value 2 (Src 2)", type number}}),
//FullOuter Join the two tables
//Then sort by Index column to regain original order
join = Table.Join(#"Added Index","Date 1",TableB,"Date 2", JoinKind.FullOuter),
#"Sorted Rows" = Table.Sort(join,{{"Index", Order.Ascending}}),
//Generate column with previous Index row
//check if there are duplicates
// (this is a faster procedure than referring to previous row with a single index column)
prevRow = fnprevRow(#"Sorted Rows","Index"),
//if prevRow=Index then flag for deletion
//then remove the Index column
#"Added Custom" = Table.AddColumn(prevRow, "delete", each [Previous Row]=[Index]),
remIndex = Table.RemoveColumns(#"Added Custom",{"Index", "Previous Row"}),
//Replace TableA entries with nulls where flagged as duplicate
x = Table.FromRecords(
Table.TransformRows(
remIndex,
(r)=>
Record.TransformFields(r,
{
{"Date 1", each if r[delete] = true then null else _},
{"Value", each if r[delete] = true then null else _},
{"Value 2 (Src 1)", each if r[delete] = true then null else _}
})
), Value.Type(remIndex)
),
//remove the "delete" column
#"Removed Columns" = Table.RemoveColumns(x,{"delete"})
in
#"Removed Columns"
Вот сценарий VBA, который я написал до сих пор:
Sub TestingDates()
Dim sourceCell As Range, targetCell As Range, formatCell As Range
Dim i As Integer
Dim LastOccRow As Long
LastOccRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LastOccRow
Set sourceCell = Range("A" amp; i)
Set targetCell = Range("D" amp; i)
Set formatCell = Range("F" amp; i)
If targetCell.Value > sourceCell.Value Then
Range("D" amp; i, "E" amp; i).Copy
targetCell.Offset(-1, 0).EntireRow.Insert Shift:=xlShiftDown
targetCell.Insert Shift:=xlShiftDown
targetCell.Offset(-1, 0).EntireRow.PasteSpecial xlPasteValues
ElseIf targetCell.Value < sourceCell.Value Then
Range("A" amp; i, "B" amp; i, "C" amp; i).Copy
targetCell.Offset(1, 0).EntireRow.Insert Shift:=xlShiftDown
targetCell.Insert Shift:=xlShiftDown
targetCell.Offset(1, 0).EntireRow.PasteSpecial xlPasteValues
'This section works fine
ElseIf targetCell.Value = sourceCell.Value Then
formatCell.Value = "Yes"
formatCell.Interior.Color = RGB(198, 239, 206)
formatCell.Font.Color = RGB(0, 97, 0)
End If
Next
End Sub
Комментарии:
1. Почему бы просто не объединить таблицы на основе столбца даты? Вы можете сделать это в VBA, Power Query или даже в формулах рабочего листа.
2. Привет @RonRosenfeld Я не уверен, что это именно то, что мне нужно, так как для каждой даты есть разное количество показаний, и, следовательно, они не будут сочетаться так, как я бы надеялся. Тем не менее, спасибо за ваш комментарий!
3. Если бы вы отредактировали свой вопрос, включив в него образец данных и то, как вы хотели бы его преобразовать, это многое прояснило бы.
4. @RonRosenfeld Я внес правки, надеюсь, это поможет прояснить ситуацию!
Ответ №1:
Я не уверен на 100%, но я думаю, что обработка и вставка строки вставляет скопированный материал во вставленную строку. Это могло бы привести к проблемам. Я изменил несколько вещей, надеюсь, это подходит к вашей проблеме.
Sub TestingDates()
Dim sourceCell As Range, targetCell As Range, formatCell As Range
Dim i As Integer
Dim LastOccRow As Long
LastOccRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LastOccRow
Set sourceCell = Range("A" amp; i)
Set targetCell = Range("D" amp; i)
Set formatCell = Range("F" amp; i)
If targetCell.Value > sourceCell.Value Then
Cells.Rows(i 1).Insert Shift:=xlDown
Range("D" amp; i, "E" amp; i).Copy Range("D" amp; i 1)
'Range("D" amp; i, "E" amp; i).Cut Range("D" amp; i 1)
i = i 1
ElseIf targetCell.Value < sourceCell.Value Then
Cells.Rows(i).Insert Shift:=xlDown
Range("A" amp; i 1, "C" amp; i 1).Copy Range("A" amp; i)
'Range("A" amp; i 1, "C" amp; i 1).Cut Range("A" amp; i)
i = i 1
'This section works fine
ElseIf targetCell.Value = sourceCell.Value Then
formatCell.Value = "Yes"
formatCell.Interior.Color = RGB(198, 239, 206)
formatCell.Font.Color = RGB(0, 97, 0)
End If
Next
End Sub
Комментарии:
1. Привет, Макс, спасибо за ответ! к сожалению, это, кажется, не полностью решило проблему. Это предотвратило сбой excel каждый раз, когда я пытаюсь запустить его, хотя это хорошая новость! Данные по-прежнему не выстраиваются в нужном порядке по дате, у кого-нибудь еще есть предложения о том, как это сделать?
Ответ №2:
Вот решение Power Query, которое создает вашу выходную таблицу из вашей входной таблицы, как показано в вашем вопросе.
Чтобы использовать Power Query
- Выберите какую-нибудь ячейку в таблице данных
Data => Getamp;Transform => from Table/Range
- Когда откроется редактор PQ:
Home => Advanced Editor
- Обратите внимание на название таблицы в строке 2
- Вставьте приведенный ниже код M вместо того, что вы видите
- Измените имя таблицы в строке 2 на то, которое было сгенерировано изначально.
- Прочитайте комментарии и изучите
Applied Steps
, чтобы понять алгоритм
Основной алгоритм состоит в том, чтобы выполнить более полное объединение двух таблиц на основе столбца даты; затем обнаружить и удалить дублированные записи строк из таблицы 1
Если ваши реальные данные не полностью представлены в вашем образце, возможно, потребуется внести некоторые изменения в кодировку.
Код M
let
//Read in the two tables
//Be sure to change names in Source lines to actual table names in your workbook
//add index column to TableA to enable replace dups with nulls
Source = Excel.CurrentWorkbook(){[Name="TableA"]}[Content],
TableA = Table.TransformColumnTypes(Source,{{"Date 1", type date}, {"Value", type number}, {"Value 2 (Src 1)", type number}}),
#"Added Index" = Table.AddIndexColumn(TableA, "Index", 0, 1, Int64.Type),
Source2 = Excel.CurrentWorkbook(){[Name="TableB"]}[Content],
TableB = Table.TransformColumnTypes(Source2,{{"Date 2", type date}, {"Value 2 (Src 2)", type number}}),
//FullOuter Join the two tables
//Then sort by Index column to regain original order
join = Table.Join(#"Added Index","Date 1",TableB,"Date 2", JoinKind.FullOuter),
#"Sorted Rows" = Table.Sort(join,{{"Index", Order.Ascending}}),
//Generate column with previous Index row
//check if there are duplicates
// (this is a faster procedure than referring to previous row with a single index column)
prevRow = fnPrevRow(#"Sorted Rows","Index"),
//if prevRow=Index then flag for deletion
//then remove the Index column
#"Added Custom" = Table.AddColumn(prevRow, "delete", each [Previous Row]=[Index]),
remIndex = Table.RemoveColumns(#"Added Custom",{"Index", "Previous Row"}),
//Replace TableA entries with nulls where flagged as duplicate
x = Table.FromRecords(
Table.TransformRows(
remIndex,
(r)=>
Record.TransformFields(r,
{
{"Date 1", each if r[delete] = true then null else _},
{"Value", each if r[delete] = true then null else _},
{"Value 2 (Src 1)", each if r[delete] = true then null else _}
})
), Value.Type(remIndex)
),
//remove the "delete" column
#"Removed Columns" = Table.RemoveColumns(x,{"delete"})
in
#"Removed Columns"
Отредактируйте, чтобы добавить пользовательскую функцию
- Создайте новый запрос из
Other Sources => Blank Query
- Переименуйте запрос:
fnPrevRow
- Откройте Расширенный редактор и замените код, который вы видите, на приведенный ниже M-код.
(MyTable as table, MyColumnName as text) =>
let
Source = MyTable,
ShiftedList = {null} amp; List.RemoveLastN(Table.Column(Source, MyColumnName),1),
Custom1 = Table.ToColumns(Source) amp; {ShiftedList},
Custom2 = Table.FromColumns(Custom1, Table.ColumnNames(Source) amp; {"Previous Row"})
in
Custom2
Комментарии:
1. Привет, Рон, это выглядит действительно здорово, спасибо! У меня возникла небольшая проблема с тем, чтобы заставить его работать, хотя я изменил заголовки на те, которые на самом деле есть в моих данных, и я получаю две ошибки. Во-первых,
Expression.Error: The import fnprevRow matches no exports. Did you miss a module reference?
и вскоре после того, как я нажму «Перейти к ошибке», он говоритExpression.Error: The name 'fnprevRow' wasn't recognized. Make sure it's spelled correctly.
, что я чувствую, что это действительно простая вещь, которую я упускаю… есть какие-нибудь мысли?2. @Engineer101 Извини за это. Это моя вина.
fnPrevRow
это пользовательская функция, которую я забыл включить. Я отредактирую свой ответ, чтобы включить это3. Это, кажется, разобралось, теперь добавлена пользовательская функция, и я думаю, что она работает, спасибо! Сейчас я получаю предупреждение, в котором говорится, что
Expression.Error: A join operation cannot result in a table with duplicate column names ("Date 1").
есть какие-либо мысли, почему это может быть?4. @Engineer101 Это означает именно то, что здесь написано. Таблица Excel (или PQ) не может содержать два столбца с одинаковым именем. Может быть, когда вы » изменили заголовки на те, которые на самом деле есть в моих данных «, что-то в этом процессе вызвало проблему? Вы могли бы выполнить вложенное объединение, но, поскольку конечный результат содержит столбцы дат с двумя разными именами, вероятно, проще всего просто изменить имя одного из столбцов дат-либо в ваших данных, либо в запросе перед объединением.
5. В этом есть смысл… Немного сбивает с толку, хотя, поскольку имена столбцов уже разные, к сожалению, я не могу поделиться точными именами или скриншотами, так как это не мои данные, которыми я могу поделиться! Я также переписал код M, который вы написали, и изменил заголовки на копии листа, чтобы они были точно такими, как я привел в качестве примера, и все равно безрезультатно. Вот где начинает проявляться мое отсутствие навыков в PQ!! есть ли что-нибудь еще, что я могу упустить? Еще раз спасибо за всю вашу помощь