Question

enter image description here

我想问几个Q.

1。下面的代码在包含“7000”的单元格之前动态添加新行

代码有效，但效率不高。它减慢了我使用For Next循环插入新行的位置。是否有更好的方法在包含“7000”的单元格之前动态插入行。

Sub PLFinalReport()

Dim XCount As Integer
Dim YCount As Integer
Dim i As Integer

JobsPivot.Activate

XCount = JobsPivot.Range("H3", Range("H3").End(xlDown)).Count

PLJob.Activate

Range("G6", Range("G6").End(xlDown)).Find("7000").Select

YCount = Range(ActiveCell, ActiveCell.End(xlUp)).Count - 2

For i = 1 To (XCount - YCount)
    ActiveCell.EntireRow.Insert
Next i

JobsPivot.Activate

JobsPivot.Range("H3", Range("H3").End(xlDown).End(xlToRight)).Copy
PLJob.Range("G6").PasteSpecial

End Sub

此外，我想将论坛从单元格B444复制到F44并将它们一直粘贴到包含公式的最后一行。与我们在excel中使用填充句柄的方式相同。

由于

Answer 1

你可以在一个声明中这样做：

Range("G6", Range("G6").End(xlDown)).Find("7000").Resize(XCount - YCount).EntireRow.Insert

至于你的第二个问题，你可以使用类似下面的内容（评论中的解释，以便你可以根据自己的需要进行调整）：

With PLJob 'reference PLJob
    With .Range("B2", .Cells(.Rows.Count, 1).End(xlUp)) 'reference its columns A and B cells from row 2 down to column A last not empty one
        .Formula = .Resize(1).Formula 'copy/paste formulas
    End With
End With

Answer 2

请尝试此代码。

Sub PLFinalReport()
    ' 13 Feb 2018

    Dim SourceRange As Range
    Dim TargetRange As Range
    Dim R As Long
    Dim C As Long

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Set SourceRange = JobsPivot.Range("H3")
    With SourceRange
        C = .End(xlToRight).Column - .Column + 1
        Set SourceRange = .Resize((.End(xlDown).Row - .Row + 1), C)
    End With

    C = 7                                           ' Column G
    With PLJob
        R = MatchRow("7000", .Cells(6, C))          ' = G6
        If R Then
            Set TargetRange = Range(.Cells(R, C), .Cells((R + SourceRange.Rows.Count - 1), C))
            TargetRange.Rows.EntireRow.Insert
            SourceRange.Copy .Cells(R, "H")         ' column H
        Else
            ' "7000" wasn't found
        End If
    End With


    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Private Function MatchRow(ByVal Crit As Variant, _
                          ByVal StartCell As Range) As Long
    ' 13 Feb 2018

    Dim Rng As Range
    Dim Rl As Long
    Dim Fnd As Range

    With StartCell.Worksheet
        Rl = .Cells(.Rows.Count, 1).End(xlUp).Row        ' find last used row
        Set Rng = Range(.Cells(StartCell.Row, StartCell.Column), _
                        .Cells(Rl, StartCell.Column))
    End With

    With Rng
        Set Fnd = .Find(What:=Crit, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
    End With

    On Error Resume Next
    MatchRow = Fnd.Row
End Function

我对Find函数更加小心，因为有很多原因可能导致找不到该项目导致＆＃34;无法解释的＆＃34;崩溃。其中一个原因是Excel会记住您上次使用Find时的大部分设置。如果您的代码没有明确要使用哪些设置，则可能无法始终使用相同的代码获得相同的结果。考虑在这方面设置LookAt属性。

我没有调查你的第二个问题，因为 - 实质上 - 这是另一个问题。

动态插入行

2 个答案: