Question

我的客户端通过突出显示数据并将其粘贴到工作表中来复制.pdf文件中的数据（Acrobat中的转换器效果不佳）。这意味着每行的最后三个单元格中的值在列之间交错。这意味着客户端必须从每一行中选择单元格并剪切并粘贴到新列中。

我看了一种方法来做到这一点，但是在我偶然发现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个单元格。有人可以帮助我解决如何实现最后一点的语法。

NB。运行宏使Excel 2016非常难以循环遍历工作表，该工作表只有少于100行。关于为什么表现缓慢的任何想法？

EDITED 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

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

看起来你正试图以“简单”的方式嵌套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编码，但我还没有解决。

连续查找最后三个单元格并粘贴到最后三列excel vba

1 个答案: