Question

我有一些Excel vba的经验但没有Access的经验。我在excel中创建了一个工具，它可以执行许多操作，并以表格中包含数据的选项卡结束。多人将使用excel作为数据输入工具。我希望最终选项卡中的数据导出到Access，以便在输入的人之间聚合数据。为了确保不会造成混乱，我需要在提交到Access时检查重复的ID。 ID变量名为ADP_Number，位于Excel和Access的第2列中。

以下代码用于将数据提交给Access，但不对ID执行任何操作。有人可以帮助我吗？

Sub ExportToAccess_DAO()

Dim oSelect As Range, i As Long, j As Integer ', sPath As String
Dim ws As DAO.Workspace
Sheets("Program_List").Activate
Set oSelect = Application.InputBox("Range", , Range("A1").CurrentRegion.Address, , , , , 8)
Dim oDAO As DAO.DBEngine
Dim oDB As DAO.Database
Dim oRS As DAO.Recordset
ChDir ActiveWorkbook.Path

Set oDAO = New DAO.DBEngine
Set oDB = oDAO.OpenDatabase("I:\ALLSHARE\MAD_14.accdb", _
False, False, "MS Access;PWD=MAD_14")
Set oRS = oDB.OpenRecordset("Program") ' change name?

For i = 2 To oSelect.Rows.Count 'skips labels
    oRS.AddNew 'addnew record to recordset
    For j = 1 To oSelect.Columns.Count ' number of columns 'Field 0 is an auto# - like an ID, so we start at 1
        oRS.Fields(j) = oSelect.Cells(i, j)
    Next j
    oRS.Update
Next i
oDB.Close

End Sub

Answer 1

你可以做两件事。

添加运行删除重复部分的代码。根据您的数据结构，最好先将所有数据复制到新选项卡，然后使用它进行导入。这可以确保所有键入的数据保持不变。

例如：

 Sheets.Add After:=Sheets("DATA")
 Sheets("Program_List").Select
 Range(oSelect.Range).Select
 Selection.Copy
 Sheets("DATA").Select
 Range("A1").Select
 ActiveSheet.Paste

对于删除重复项，你有选项，并确保你的vba恰到好处，我会记录删除重复项步骤并在该块的末尾追加它。

我会把它放在ChDir行之后的代码的开头。

另一种选择可能是对Access数据库稍作更改。如果您无法控制Access环境，则始终无法执行此操作。如果您可以导入临时表，那么您可以编写一个查询，只在插入所需的数据表时才选择不同的值。您的数据库对象可以从Excel运行查询。

例如：

在Access中，您需要一个临时表 - TEMP_TableName - 这是您需要数据的表的副本。
更改Excel VBA以使用此新表。
创建SELECT DISTINCT查询。这假设所有重复值在所有列中具有相同的值。如果它没有，那么你将需要创建一个更复杂的查询，使用GROUP BYS，Min / Max，Fist / Last等来获得唯一值。
一旦查询仅返回您想要将其转换为追加查询的值。选择最终目标表作为附加到源。
在excel中，您需要一行新的代码。
```
 oDB.OpenQuery("QueryName")
```

其中任何一个都会将您的数据导入Access而不会重复。

vba：将Excel导出到Access，删除重复的ID

1 个答案: