Обычно я бы сказал, чтобы предоставить дополнительную информацию. на то, что вы ищете (так как есть много способов сделать это). Но у меня есть два макроса, которые, как я думаю, будут делать то, что вы хотите сделать без большого редактирования (если есть). Обратите внимание, что я написал это давно (раньше, чем я знал, что лучше), поэтому они не очень красивы.
Первый предложит вам выбрать строку с наибольшим количеством данных (чтобы получить lastRow), а затем спросить, какие столбцы копировать данные вниз. В вашем случае вы хотите скопировать A, B, C, D и E (я думаю, E, если у него есть текст «Node3.1.1.1 - DataHIJ»).
Sub GEN_USE_Copy_Data_Down_MULTIPLE_Columns(Optional myColumns As Variant, Optional thelastRow As Variant)
Dim yearCol As Integer, countryCol As Integer, commodityCol As Integer, screenRefresh As String, runAgain As String
Dim lastRow As Long, newLastRow As Long
Dim copyFrom As Range
Dim c As Range
Dim Cell As Range
Dim SrchRng As Range
Dim SrchStr As String
Dim LastRowCounter As String
Dim columnArray() As String
Dim Column2Copy As String
If Not IsMissing(myColumns) Then
columnArray() = Split(myColumns)
Else
MsgBox ("Now, you will choose a column, and that column's data will be pasted in the range" & vbCrLf & "below the current cell, to the next full cell")
Column2Copy = InputBox("What columns (A,B,C, etc.) would you like to copy the data of? Use SPACES, to separate columns")
columnArray() = Split(Column2Copy)
screenRefresh = MsgBox("Turn OFF screen updating while macro runs?", vbYesNo)
If screenRefresh = vbYes Then
Application.ScreenUpdating = False
Else
Application.ScreenUpdating = True
End If
End If
Dim EffectiveDateCol As Integer
If IsMissing(thelastRow) Then
LastRowCounter = InputBox("What column has the most data (this info will be used to find the last used row")
Else
LastRowCounter = thelastRow
lastRow = thelastRow
End If
CopyAgain:
If IsMissing(thelastRow) Then
With ActiveSheet
lastRow = .Cells(.Rows.Count, LastRowCounter).End(xlUp).row
'lastRow = .UsedRange.Rows.Count
End With
End If
Dim startCell As Range
For i = LBound(columnArray) To UBound(columnArray)
Debug.Print columnArray(i) & " is going to be copied now."
Column2Copy = columnArray(i)
Set startCell = Cells(1, Column2Copy).End(xlDown)
Do While startCell.row < lastRow
If startCell.End(xlDown).Offset(-1, 0).row > lastRow Then
newLastRow = lastRow
Else
newLastRow = startCell.End(xlDown).Offset(-1, 0).row
End If
Set copyFrom = startCell
Range(Cells(startCell.row, Column2Copy), Cells(newLastRow, Column2Copy)).Value = copyFrom.Value
Set startCell = startCell.End(xlDown)
Loop
Next i
If IsEmpty(myColumns) Then
runAgain = MsgBox("Would you like to run the macro on another column?", vbYesNo)
If runAgain = vbNo Then
Cells(1, 1).Select
Exit Sub
ElseIf runAgain = vbYes Then
GoTo CopyAgain
End If
End If
MsgBox ("Done!")
End Sub
Затем запустите этот и выберите строку, которую вы хотите удалить, когда найдена пустая ячейка. Я думаю, вы должны иметь возможность использовать столбец D (или, может быть, это E?).
Sub GEN_USE_Delete_Entire_Row_based_on_Empty_Cell(Optional thelastRow As Variant, Optional iColumn As Variant)
Dim yearCol As Integer, countryCol As Integer, commodityCol As Integer, screenRefresh As String
Dim lastRow As Long, newLastRow As Long, LastRow2 As Long
Dim copyFrom As Range
Dim c As Range
Dim Cell As Range
Dim SrchRng As Range
Dim SrchStr As String
Dim LastRowCounter As String
Dim i As Long
Dim aRng As Range, cell1 As Range, cell2 As Range
If IsMissing(thelastRow) Then
screenRefresh = MsgBox("Turn OFF screen updating while macro runs?", vbYesNo)
If screenRefresh = vbYes Then
Application.ScreenUpdating = False
Else
Application.ScreenUpdating = True
End If
End If
Dim EffectiveDateCol As Integer
If IsMissing(thelastRow) Then
LastRowCounter = InputBox("What column has the most data (this info will be used to find the last used row)")
Else
LastRowCounter = iColumn
End If
'Note, you can use LastRow2 to also find the last row, without prompting the user...but note it uses ACTIVECELL
LastRow2 = ActiveCell.SpecialCells(xlCellTypeLastCell).row
CopyAgain:
With ActiveSheet
lastRow = .Cells(.Rows.Count, LastRowCounter).End(xlUp).row
End With
If IsMissing(iColumn) Then
MsgBox ("Now, you will choose a column. Any cell in that column that is blank, will have that ENTIRE ROW deleted")
End If
Dim Column2DeleteRowsFrom As String
If IsMissing(iColumn) Then
Column2DeleteRowsFrom = InputBox("What column (A,B,C, etc.) would you like to delete entire row when a blank cell is found?")
Else
Column2DeleteRowsFrom = iColumn
End If
'If there are headers, then stop deleting at row 2
Dim headerQ As Integer
If IsMissing(iColumn) Then
headerQ = MsgBox("Does the sheet have headers?", vbYesNo)
If headerQ = vbYes Then
headerQ = 2
Else
headerQ = 1
End If
Else
headerQ = 2
End If
Set cell1 = Cells(2, Column2DeleteRowsFrom)
Set cell2 = Cells(lastRow, Column2DeleteRowsFrom)
Set aRng = Range(cell1, cell2)
Range(Cells(headerQ, Column2DeleteRowsFrom), Cells(lastRow, Column2DeleteRowsFrom)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
MsgBox ("Done removing blank cell rows!")
End Sub
Да, как я уже сказал, они не очень красивы. Я оставляю это как упражнение для чтения, чтобы подтянуть/удалить лишние вещи.
Вы можете прокручивать столбцы, копируя данные до последней пустой ячейки. Затем удалите строки на основе пустой ячейки в столбце D. – BruceWayne
Или вы можете использовать столбцы temp (например, G) с условной проверкой, если столбец A в той же строке имеет какие-либо значения, если не заполняется значением выше. Затем вы можете копировать как значения и заменять исходную таблицу. Сделайте то же самое для всех уровней вашего дерева. – nbayly
Другими словами, существует много способов реализовать это, и этот вопрос слишком широк *. –