VBA Paste Into Видимые ячейки только Оптимизация - PullRequest
Новая
       28

VBA Paste Into Видимые ячейки только Оптимизация

0 голосов
/ 15 ноября 2018

Итак, я написал код, который вставляет скопированный диапазон из буфера обмена в видимые ячейки, начиная только с активной ячейки, отмеченной пользователем

Я уже оптимизировал свой код, немного ускорив его с 7200 ячеек / мин до 42000 ячеек / мин, но я думаю, что еще есть много возможностей для оптимизации. Но из-за того, что для меня это третий день программирования на VB, я прошу сообщество за полезные советы и подсказки, как сделать мой код быстрее

То, как я справляюсь, это вставка буфера обмена в новый лист и затем ищите следующую видимую ячейку, чтобы вставить в нее, я использую переменную max length для «ограничения» поиска, но в моем приложении тысячи ячеек могут быть невидимыми.

Я думал об использовании 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
...