查找记录并进行更新

时间:2012-12-14 15:47:07

标签: excel vba

我有一些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 

1 个答案:

答案 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