excel - 仅将 VBA 粘贴到可见单元中优化

Question

所以我编写了代码，将剪贴板中的复制范围粘贴到可见单元格中，仅从用户标记的活动单元格开始

我已经优化了我的代码，将其从 7200 细胞/分钟加速到 42000 细胞/分钟，但我认为仍有很大的优化空间。但由于这是我为 VB 编程的第三天，我向社区寻求有用的提示和技巧，以使我的代码更快

我处理它的方式是将剪贴板粘贴到一个新的工作表中，然后搜索下一个要插入的可见单元格，我使用变量最大长度来“限制”搜索，但在我的应用程序中，数千个单元格可能是不可见的。

我想过使用 StringBuilder 让它运行得更快，但不知道如何实现它

重要的是行和列都可以不可见

On Error GoTo ErrorHandler 'Enable Error Handling


Application.ScreenUpdating = False
Dim tblRow1 As Integer, lRow As Integer
Dim tblName As String
Dim lastRow, lastCol As Long
Dim outX, outY As Long
Dim maxLength As Long
clipboardTable As String     
outputTable As String  



outputTable = ActiveSheet.Name 'Safe the Name of the target sheet

outY = ActiveCell.Row           'Safe the Target position in sheet with xY coordinates
outX = ActiveCell.Column

 maxLength = Sheets(outputTable).UsedRange.Rows.Count

outYtmp = outY                  'Is needed to reset the corsur from the bottom to top

Set wbook = ActiveWorkbook
Set clipSheet = wbook.Sheets.Add


clipboardTable = clipSheet.Name

Sheets(clipboardTable).Activate
Sheets(clipboardTable).PasteSpecial


'Start Sheet
Sheets(clipboardTable).Select
lastRow = Sheets(clipboardTable).UsedRange.Rows.Count
lastCol = Sheets(clipboardTable).UsedRange.Columns.Count

'MsgBox ActiveSheet.UsedRange.Rows.Count
'MsgBox ActiveSheet.UsedRange.Columns.Count
'MsgBox " " & Sheets(inTable).Rows(1).EntireRow.Hidden



Sheets(outputTable).Select

For x = 1 To lastCol
Sheets(outputTable).Select
For j = 1 To maxLength
    If Sheets(outputTable).Columns(outX).Hidden = False Then
        For y = 1 To lastRow
            For i = 1 To maxLength
                If Sheets(outputTable).Rows(outY).Hidden = False Then

                    Sheets(outputTable).Cells([outY], [outX]) = Sheets(clipboardTable).Cells([y], [x])
                    outY = outY + 1
                    Exit For

                End If
            outY = outY + 1
            Next
        Next

        outX = outX + 1
        Exit For
    End If
 outX = outX + 1
Next
outY = outYtmp

Next
    Application.DisplayAlerts = False
    Sheets(clipboardTable).Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
Exit Sub

    ErrorHandler:  ' Error-handling routine.
    If (Worksheets(clipboardTable).Name <> "") Then
        Application.DisplayAlerts = False
        Sheets(clipboardTable).Delete
    Application.DisplayAlerts = True
End If


End Sub

标签： excelvbaoptimizationcellvisible