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

Question

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

我曾想过一种方法来做到这一点，但在我偶然发现 Bruce Wayne 的代码将每行的最后一个单元格移动到最后一列之前，我绞尽了脑汁：

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 行。关于性能缓慢的原因有什么想法吗？

编辑Post

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

右侧三列中的数据来自每列最远 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

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

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

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

 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 中编码，但我还没有解决这个问题。

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

Find last three cells in a row cut and paste to last three columns excel vba

vba

excel

excel-2016