查找行中的最后三个单元格剪切并粘贴到最后三列excel vba

Question

我的客户通过突出显示 .pdf 文件并粘贴到工作表中复制了数据（Acrobat 中的转换器无法正常工作）。这意味着每行最后三个单元格中的值在各列中交错排列。这意味着客户端必须从每一行中选择单元格并剪切并粘贴到新列中。

我寻找了一种方法来做到这一点，但在我偶然发现布鲁斯韦恩的代码之前破坏了我的大脑，该代码将每行的最后一个单元格移动到最后一列：

Sub move_data()
Dim LastRow As Long, lastCol As Long
Dim ws As Worksheet

Set ws = Worksheets("Sheet1")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
lastCol = ws.UsedRange.Columns.Count

Cells.EntireColumn.AutoFit

Dim i As Long
For i = 1 To LastRow
    If ws.Cells(i, lastCol) = "" Then
       ws.Cells(i, ws.Cells(i, 1).End(xlToRight).Column).Cut
       ws.Cells(i,lastCol)               
   End If
Next i

End Sub

所以，这正是我想要的，也是该行最后一个单元格左侧的 2 个单元格。有人可以帮助我了解如何实现最后一点的语法。

注意。运行宏使 Excel 2016 非常努力地循环工作表，该工作表只有不到 100 行。关于为什么性能缓慢的任何想法？

已编辑帖子

为了在执行替换代码后显示工作表的表示，这里是我的数据的屏幕截图：

右侧三列中的数据来自每列最远 3 个单元格中的值，但是，正如您在第 18 行中看到的那样，代码不起作用。任何关于为什么会有用的线索。

Answer 1

我尝试阅读您的代码，但不是很成功。很明显，您正在尝试从上到下循环：

For i = 1 To LastRow
    If ws.Cells(i, lastCol) = "" Then
       ws.Cells(i, ws.Cells(i, 1).End(xlToRight).Column).Cut
       ws.Cells(i,lastCol)               
   End If
Next i

但是您没有对行进行足够深的评估以识别最后三个单元格，您实际上并没有移动任何数据，而且我认为您会在第一次迭代时抛出错误。

看起来您正在尝试以嵌套 For 循环的“简单”方式执行此操作，而您报告的缓慢几乎证实了这一点。嵌套 For 循环快速且易于编写，但如果您选择或更改数千个单元格，它们可能需要很长时间才能运行。您可以通过最小化您激活/更改的单元格数量以及关闭屏幕更新来提高速度。

如果粘贴到新模块中，下面的代码应该可以工作。我尝试遵循与您的示例相同的逻辑，但有所偏差。

 Sub move_data()
    Dim LastRow As Long, LastCol As Long, LastCell As Long
    Dim ws As Worksheet
    Dim ColLimit as Integer
    Dim i As Integer, j As Integer

    Application.ScreenUpdating = False

    Set ws = ActiveSheet
    ColLimit = 2    ' [0 through 2] = 3, # of columns to populate
    LastRow = ws.UsedRange.Rows.Count
    LastCol = ws.UsedRange.Columns.Count
    Cells.EntireColumn.AutoFit

    For i = 1 To LastRow
       LastCell = LastCol
        For j = 0 To ColLimit
            LastCell = ws.Cells(i, LastCol - j).End(xlToLeft).Column
            If LastCell > 0 And ws.Cells(i, LastCol - j) = "" Then
                LastCell = ws.Cells(i, LastCol - j).End(xlToLeft).Column
                ws.Cells(i, LastCell).Copy ws.Cells(i, LastCol - j)
                ws.Cells(i, LastCell) = ""
            End If
       Next j
    Next i

    Application.ScreenUpdating = True

    End Sub

` 如果速度是一个问题，那么您应该远离这些循环并使用 数组和范围。它们的速度明显更快。

对于咯咯笑，这是可以在大约 30 秒内手动完成的方法，并且可能还有一种我还没有见过的更简单的方法！

Highlight the data range
Ribbon, Data tab, From Table/Range (opens query editor)
Ribbon, Transform tab, Transpose
Ribbon, Transform tab, Reverse Rows
File, Close and load, to worksheet
Highlight the data range
Ribbon, Design, Convert to Range
Goto Blanks (Ctrl G - Special - Blanks)
Delete blanks - Move Cells up (Alt E, D)

现在，顶行包含列中的所有值。如果您希望它们在列中但不关心列是否反转，您可以复制和粘贴特殊转换。

但如果你想要那些完全相同的列：

Highlight the data range
Ribbon, Data tab, From Table/Range (opens query editor)
Ribbon, Transform tab, Reverse Rows
Ribbon, Transform tab, Transpose
File, Close and load, to worksheet

现在您的列在右侧。当然 Power Query 可以用 VBA 编码，但我还没有解决这个问题。