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

Question

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

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

下面是我的宏运行后工作表的示例：

我正在尝试检查 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

将“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 列，因此“单元格”是该范围内的一个单元格，而不是 C 列中的一个单元格。因此，您要测试那些不为空的单元格，然后将它们的值放在 C 列中的相应单元格中. :-)

Answer 2

正如 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