我有一些excel表,用户必须在sheet2上插入数据列表。 然后用户点击一个按钮,并根据sheet2中的数据插入更新sheet1。
此代码将查找工作表中是否缺少sheet2中的数据,然后正确插入数据。 我还需要对现有记录进行操作。 sheet1上的现有数据已添加了带注释的manuel列,这些注释不应在数据更新时删除。
sheet1上的数据位于C到N列 - 键位于J。
Dim iLast As Long
Dim iCounter As Integer
iLast = Sheets(2).Range("I" & Application.Rows.Count).End(xlUp).Row
Dim rng As Range
For iCounter = 2 To iLast
Set rng = Sheets(1).Range("J:J").Find(Sheets(2).Range("I" & iCounter).Value)
If rng Is Nothing Then
Sheets(2).Range("B" & iCounter & ":" & "M" & iCounter).Copy
Sheets(1).Range("C" & Sheets(1).Range("J" & Application.Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteAll
Range("B2").Select
'Insert mailto link
Selection.Copy
Sheets(1).Range("B" & Sheets(1).Range("J" & Application.Rows.Count).End(xlUp).Row).Select
'Range("B3").Select
ActiveSheet.Paste
ActiveSheet.Paste
Application.CutCopyMode = False
Else
'MsgBox "update existing row with new data - how to"
End If
Next iCounter
答案 0 :(得分:0)
您应该能够以类似的方式添加新行。
如果使用xlPasteValues而不是xlPasteAll,则不应影响工作表1中的注释。
假设您只是复制值,并且没有额外的格式或注释要复制。
我不确定你想要达到的目标对我来说有点困难,但我认为这就是你想要做的事情?
Dim iLast As Long
Dim iCounter As Integer
iLast = Sheets(2).Range("I" & Application.Rows.Count).End(xlUp).Row
Dim rng As Range
For iCounter = 2 To iLast
Set rng = Sheets(1).Range("J:J").Find(Sheets(2).Range("I" & iCounter).Value)
If rng Is Nothing Then
Sheets(2).Range("B" & iCounter & ":" & "M" & iCounter).Copy
Sheets(1).Range("C" & Sheets(1).Range("J" & Application.Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteAll
Range("B2").Select
'Insert mailto link
Selection.Copy
Sheets(1).Range("B" & Sheets(1).Range("J" & Application.Rows.Count).End(xlUp).Row).Select
'Range("B3").Select
ActiveSheet.Paste
ActiveSheet.Paste
Application.CutCopyMode = False
Else
Sheets(2).Range("B" & iCounter & ":" & "M" & iCounter).Copy
Sheets(1).Range("C" & rng.Row).PasteSpecial xlPasteValues
End If
Next iCounter