Excel VBA - 将多列数据移动到单列

Question

我现在有一个宏，可以将数据从不同的 sheet 提取到新的 sheet，然后将数据格式化为我可以使用的格式。我遇到的问题是，我从另一个 sheet 中提取的一些 PN 位于不同的单元格中，以便于查看。（例如，顶级 PN 位于单元格 C2 中，属于 C2 中部分的任何部分都可能列在 D3 中，以表明它是子部分）。

我需要将所有 PN 跨不同列移动到单个列中的代码。移动所有 PN 后，应删除其他列（D 到 F）。数据范围从 C 列到 F 列。根据宏从中提取数据的 table，数据的长度会有所不同。宏需要能够处理这个。

这是我的 sheet 在我的宏运行s:

之后的样子的示例

我正在尝试检查 C 列是否有空行。如果说 C3 是空的，那么我想检查 D3 中的文本。如果有文字，我希望 D3 中的文字移动到 C3。如果没有文本，请检查 E3。重复相同的过程。根据我在网上找到的内容，到目前为止我有这段代码（但是，它在我的宏中没有运行正确）...

'Copy PNs that are out of line and paste them in the correct column
Dim N As Long, i As Long, j As Long

Set ws1 = Worksheets("KDLSA")

N = ws1.Cells(Rows.Count, "C").End(xlUp).Row
j = 4

For Each cell In Range("D2:F" & ws1.Cells(Rows.Count, "F").End(xlUp).Row)


    If cell.Value = "" Then 'if cell C is blank, I want to shift the text to fill column C
        ws1.Range("C" & j).Value = ws1.Range("D" & cell.Row).Value 'copy PN in column E to column D - this needs to be more robust to cover my range of columns rather than just D and E
        j = j + 1
    End If


Next cell

感谢任何帮助。

Answer 1

正如 Tehscript 提到的，您不需要宏。如果您仍然想使用宏（也许您的实际情况比示例更复杂），这里是您的起点。

下面的例子只会移动一次单元格。所以你可能想多次执行循环。（您也可以遍历 rowIndex 并对每一行使用 while 循环。）

代码可以进一步重构，但我希望这样它很容易阅读。

Sub ShiftCells()


Dim myWorkSheet As Worksheet
Set myWorkSheet = Worksheets("Tabelle1")

Dim maxRowIndex As Long
maxRowIndex = GetMaxRowIndex(myWorkSheet)

Dim rowIndex As Long
Dim columnIndex As Long

Dim leftCell As Range
Dim rightCell As Range

For Each Cell In Range("C2:F" & maxRowIndex)
    If Cell.Value = "" Then
       shiftedCell = True
       rowIndex = Cell.Row
       columnIndex = Cell.Column

       Set leftCell = myWorkSheet.Cells(rowIndex, columnIndex)
       Set rightCell = myWorkSheet.Cells(rowIndex, columnIndex + 1)

       leftCell.Value = rightCell.Value
       rightCell.Value = ""

    End If


Next Cell


End Sub

Function GetMaxRowIndex(ByVal myWorkSheet As Worksheet) As Long
    Dim numberofRowsInColumnC As Long
    numberofRowsInColumnC = myWorkSheet.Cells(Rows.Count, "C").End(xlUp).Row

    Dim numberofRowsInColumnD As Long
    numberofRowsInColumnD = myWorkSheet.Cells(Rows.Count, "D").End(xlUp).Row

    Dim numberofRowsInColumnE As Long
    numberofRowsInColumnE = myWorkSheet.Cells(Rows.Count, "E").End(xlUp).Row

    Dim numberofRowsInColumnF As Long
    numberofRowsInColumnF = myWorkSheet.Cells(Rows.Count, "F").End(xlUp).Row

    Dim maxNumberOfRows As Long
    maxNumberOfRows = WorksheetFunction.Max(numberofRowsInColumnC, _
                                                numberofRowsInColumnD, _
                                                numberofRowsInColumnE, _
                                                numberofRowsInColumnF _
                                                )
    GetMaxRowIndex = maxNumberOfRows
End Function

Answer 2

将您的 "For" 块更改为：

With ws1.UsedRange
    lastRow = .Rows(.Rows.Count).Row
End With
For Each cell In Range("C2:C" & lastRow)
    If cell.Value = "" Then
       thisRow = cell.Row
       For Each horCell In Range(Cells(thisRow, "D"), Cells(thisRow, "F"))
            If Not horCell.Value = "" Then
                cell.Value = horCell.Value
                Exit For
            End If
       Next horCell

    End If


Next cell
Range("D:F").EntireColumn.Delete

通过只循环C列，只有当C为空时，你才可以循环D-F，当你找到有数据的时候，它会把它放在C中。

如果您还需要列数的动态范围，则执行：

With ws1.UsedRange
    lastRow = .Rows(.Rows.Count).Row
    lastColumn = .Columns(.Columns.Count).Column
End With
For Each cell In Range("C2:C" & lastRow)
    If cell.Value = "" Then
       thisRow = cell.Row
       For Each horCell In Range(Cells(thisRow, "D"), Cells(thisRow, lastColumn))
            If Not horCell.Value = "" Then
                cell.Value = horCell.Value
                Exit For
            End If
       Next horCell

    End If


Next cell
Range(Cells(2, "D"), Cells(2, lastColumn)).EntireColumn.Delete

或者在 for 循环 "to" 范围内使用正确的 lastRow，将代码更改为

If Not cell = "" then
     ws1.range ("C" & cell.Row).Value = cell.Value
 End if

您正在循环 D-F 列，因此 "cell" 是该范围内的单元格，而不是 C 列中的单元格。因此您想要测试非空单元格，然后将它们的值放入相应的单元格中C 列中的单元格。:-)

Excel VBA - 将多列数据移动到单列

Excel VBA - Shift data across multiple columns to a single column

excel

vba

multiple-columns