Question

我有4张纸，分别是Name 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

enter image description here

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中的行数多次执行此操作？最后，您要按照Ws4的范围将WsPro的每一行粘贴到WsSum的末尾。也许Ws4不应该总是同一张纸。

现在的代码非常小巧。可以按照您想要的方式对其进行修改，这很容易。因此，希望我的意见对您有所帮助。

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

1 个答案: