用新创建的记录替换第一条记录，而不是在excell工作表中创建新行
用新创建的记录替换第一条记录，而不是在excell工作表中创建新行
提问于 2019-01-03 21:02:35
我有4张图纸名为项目创建，阿肖克，主板和图纸主板
工作表包含关于项目细节的数据和一些列数据将被复制到项目工作表的时候项目的结构(标题名称和设计与合并的行)，并将从主表加载几列数据，如果我在主表中插入新行，它应该更新具有较少列数据的项目工作表，但使用子工作表结构(空设计模板)。
我实现了下面的代码，问题是每次它替换第一个记录(它是合并的行)时，我的意思是如果插入第二行，它将被替换。
请帮助我，并参考图片
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
回答 1
Stack Overflow用户
发布于 2019-01-03 21:52:43
下面的代码根本不是要运行的。我的意图是提供一个基础，从中灌输感觉。我希望你是那个负责灌输的人。
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不应该总是同一张表。
代码现在很小，也很简洁。应该很容易修改它，让它做您想要做的事情。因此，我希望我的意见能对您有所帮助。
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/54022851
复制相关文章
相似问题
腾讯云开发者
