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

内容来源于 Stack Overflow,并遵循CC BY-SA 3.0许可协议进行翻译与使用

  • 回答 (1)
  • 关注 (0)
  • 查看 (23)

我有4张名为Project Creation,Ashok,Master和Sheet Main的表

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

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

请帮帮我并参考图片

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

提问于
用户回答回答于

以下代码仅供参考

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不应该总是相同的表。

代码非常小而且简洁。它应该很容易修改它的方式,它做你想要它做的。因此,我希望我的意见能帮到你。

所属标签

可能回答问题的人

  • HKC

    红客学院 · 创始人 (已认证)

    26 粉丝7 提问5 回答
  • Dingda

    Dingda · 站长 (已认证)

    4 粉丝0 提问3 回答
  • 螃蟹居

    1 粉丝0 提问2 回答
  • 西风

    renzha.net · 站长 (已认证)

    9 粉丝1 提问2 回答

扫码关注云+社区

领取腾讯云代金券