代码

Question

因此，在工作簿中，我有两个工作表：一个包含一个与SQL数据库相关联的创意表，另一个包含从该表中选择的某些创意。

从数据库表中，我想将符合特定条件的想法复制到第二个表中。在那里他们将被用户给予某些数字排名

Idea 1    0    4    5    3    8
Idea 2    7    5    1    5    4
Idea 3    1    2    8    8    2

根据包含按钮的时钟，我想更新数据库表，并将任何 NEW 想法复制到评级表中，以便它可能类似于以下内容。

Idea 1    0    4    5    3    8
Idea 2    7    5    1    5    4
Idea 3    1    2    8    8    2
New Idea1  
New Idea2

如何完成此复制？如果不覆盖已经包含的评级，我无法想象这样做的方法。

代码

用于将所有ID号复制到评级表的代码。

Sub CopyFilter()

Dim rng As Range
Dim rng2 As Range

With ActiveSheet.AutoFilter.Range
    On Error Resume Next
        Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
            .SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
End With

If rng2 Is Nothing Then
    MsgBox "No data to copy"
Else
    Set rng = Worksheets("Ideas").ListObjects("IdeasTable"). _
        ListColumns(1).DataBodyRange
    rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy

    Worksheets("WFNs").Range("B5").PasteSpecial Paste:=xlPasteFormulas, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End If

ActiveSheet.ShowAllData
Worksheets("WFNs").Activate

End Sub

Answer 1

您需要做的是，保存有关插入内容的信息。首先，声明一个这样的全局变量：

Dim startRow as Long

在你的潜艇中：

If startRow = 0 Then
    startRow = 1 
End If 

With ActiveSheet.AutoFilter.Range
    On Error Resume Next
        Set rng2 = .Offset(startRow, 0).Resize(.Rows.Count - 1, 1) _
            .SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
End With

您只需复制新条目，而不是始终复制整个范围。现在您已经有了起始行，您可以在if中使用它来粘贴旧日期之后的数据：

Else
    Set rng = Worksheets("Ideas").ListObjects("IdeasTable"). _
        ListColumns(1).DataBodyRange
    rng.Offset(startRow, 0).Resize(rng.Rows.Count - 1).Copy

    Worksheets("WFNs").Range("B" & (startRow + 4)).PasteSpecial Paste:=xlPasteFormulas, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    startRow = rng.Rows.Count - 1
End If

我只在其中更改了包含startRow的行。（未经测试;））

数据库同步后VBA保留信息

代码

1 个答案: