如何优化我在 excel 2010 年为 2016 年编译的这个宏？

Question

我有一个搜索字符串的宏，当它找到它时，它会复制并粘贴值和格式。

它在 2016 年运行得相当慢，当然是 2010 年。我一直无法弄清楚如何解决它。

Sub CommandButton1_Click()
    Dim strsearch As String, lastline As Long, tocopy As Long

    strsearch = CStr(InputBox("enter the string to search for"))
    lastline = Range("A65536").End(xlUp).Row
    J = 190

    For i = 1 To lastline
        For Each c In Range("G" & i & ":Z" & i)
            If InStr(c.Text, strsearch) Then
                tocopy = 1
            End If
        Next c 

        If tocopy = 1 Then
            Range(Cells(i, 1), Cells(i, 6)).Copy
            Sheets("Report").Range("A" & J).PasteSpecial (xlValues)
            Sheets("Report").Range("A" & J).PasteSpecial (xlFormats)
            J = J + 1
        End If

        tocopy = 0
    Next i
End Sub

Answer 1

也许像这样的东西会很快为你工作：

Sub CommandButton1_Click()


    Dim wb As Workbook
    Dim wsData As Worksheet
    Dim wsDest As Worksheet
    Dim rFind As Range
    Dim rCopy As Range
    Dim sFind As String
    Dim sFirst As String

    sFind = InputBox("Enter the string to search for:")
    If Len(sFind) = 0 Then Exit Sub 'Pressed cancel

    Set wb = ActiveWorkbook
    Set wsData = wb.ActiveSheet
    Set wsDest = wb.Worksheets("Report")

    With wsData.Range("G1:Z" & wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row)
        Set rFind = .Find(sFind, .Cells(.Rows.Count, .Columns.Count), xlValues, xlPart)
        If Not rFind Is Nothing Then
            sFirst = rFind.Address
            Set rCopy = rFind
            Do
                Set rCopy = Union(rCopy, rFind)
                Set rFind = .FindNext(rFind)
            Loop While rFind.Address <> sFirst

            Intersect(rCopy.Parent.Range("A:F"), rCopy.EntireRow).Copy
            wsDest.Range("A190").PasteSpecial xlPasteValues
            wsDest.Range("A190").PasteSpecial xlPasteFormats
        End If
    End With

End Sub

如何优化我在 excel 2010 年为 2016 年编译的这个宏？

How can I optimize this macro I compiled in excel 2010 for 2016?

excel

vba

excel-2010

excel-2016