用新创建的记录替换第一条记录，而不是在 Excel 工作表中创建新行

Question

我有 4 张名称 Project Creation、Ashok、Master 和 Sheet 主要

Sheet 包含有关项目详细信息以及数据和一些列数据将被复制到项目表当时的项目结构（标题名称和合并行的设计），如果我插入新的，将从主工作表加载几列数据主工作表中的行，它应该使用少量列数据更新项目工作表，但使用子工作表结构（空设计模板）。

我实现了以下代码，问题是每次替换第一条记录（它是合并的行）我的意思是如果插入第二行它正在替换。

请帮助我并参考图片

Private Sub CopyDataFrmExcell()
Dim xRCount As Long
    Dim xSht As Worksheet
     Dim ws As Worksheet
    Dim xNSht As Worksheet

  Dim lrs As Long, lrd As Long, p As Long, brd As Long, krd As Long, LastRowNumber As Long

lrs = Sheets("ProjectCreation").Cells(Sheets("ProjectCreation").Rows.Count, 1).End(xlUp).Row
With Sheets("Ashok")  'longer to type than "Summary"
    For p = 2 To lrs 'assumes header in row 1

        If p = 2 Then
            lrd = .Cells(.Rows.Count, 1).End(xlUp).Row
           Sheets("Ashok").Cells(5, 7).Value = Sheets("ProjectCreation").Cells(p, 9).Value
            brd = .Cells(.Rows.Count, 1).End(xlUp).Row
            .Cells(5, 8).Value = Sheets("ProjectCreation").Cells(p, 10).Value
            krd = .Cells(.Rows.Count, 1).End(xlUp).Row
            .Cells(5, 9).Value = Sheets("ProjectCreation").Cells(p, 11).Value

           Else
           Sheets("Sheet4").Select
            Sheets("Sheet4").Range("A1:Y6").Copy Destination:=Sheets("Ashok").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
           Sheets("Ashok").Select
           LastRowNumber = Sheets("Ashok").Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row     
          lrd = .Cells(.Rows.Count, 1).End(xlUp).Row
         Sheets("Ashok").Cells(LastRowNumber + 1, 7).Value = Sheets("ProjectCreation").Cells(p, 9).Value
          brd = .Cells(.Rows.Count, 6).End(xlUp).Row
          .Cells(LastRowNumber + 1, 8).Value = Sheets("ProjectCreation").Cells(p, 10).Value
           krd = .Cells(.Rows.Count, 6).End(xlUp).Row
        .Cells(LastRowNumber + 1, 9).Value = Sheets("ProjectCreation").Cells(p, 11).Value    
        End If
Next p
End With
End Sub

Answer 1

下面的代码绝不会运行。我的目的是提供一个基础，从中灌输感觉。我希望你会成为灌输的人。

Private Sub CopyDataFrmExcell()

    Dim WsPro As Worksheet
    Dim WsSum As Worksheet
    Dim Ws4 As Worksheet
    Dim R As Long
    Dim RlPro As Long, RlSum As Long

    Set WsPro = Worksheets("ProjectCreation")
    Set WsSum = Worksheets("Ashok")                 'longer to type than "Summary"
    Set Ws4 = Worksheets("Sheet4")

    With WsPro
        RlPro = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    With WsSum
        For R = 2 To RlPro                          'assumes header in row 1
            If R = 2 Then
                WsPro.Range("I2:K2").Copy .Cells(5, 7)
            Else
                Ws4.Range("A1:Y6").Copy Destination:=.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                RlSum = .Cells(.Rows.Count, 1).End(xlUp).Row
                WsPro.Range(Cells(R, 9), Cells(R, 11)).Copy .Cells(RlSum + 1, 7)
            End If
        Next R
    End With
End Sub

如您所见，我已尝试为变量赋予一些有意义的名称。您现在将能够从它们的名称中识别它们。反过来，这使您能够阅读仍然没有意义的代码叙述。

代码的核心循环遍历 WsPro 中的每一行，然后在 WsSum 中执行一些操作。这似乎不合逻辑。好的，您想将标头从 WsPro 复制到 WsSum。这真的不需要循环，不是吗？然后你想将范围 Ws4.Range("A1:Y6") 复制到 WsSum 的末尾。很公平，但是为什么必须根据 WsPro 中的行数多次执行此操作？最后，您希望将 WsPro 的每一行粘贴到 WsSum 的末尾，从 Ws4 开始。也许 Ws4 不应该总是同一张纸。

现在的代码非常小而简洁。应该很容易修改它，使其符合您的预期。因此，我希望我的意见对您有所帮助。