VBA代码更新/创build新的logging从Excel到Access

我一直在试图寻找答案，但我在VBA中的基础技能不足以帮助我确定我正在编写的代码。

到目前为止，我有这个代码：

Sub ADOFromExcelToAccess() ' exports data from the active worksheet to a table in an Access database ' this procedure must be edited before use Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long ' connect to the Access database Set cn = New ADODB.Connection cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _ "Data Source=\\GSS_Model_2.4.accdb;" ' open a recordset Set rs = New ADODB.Recordset rs.Open "Forecast_T", cn, adOpenKeyset, adLockOptimistic, adCmdTable ' all records in a table For i = 4 To 16 x = 0 Do While Len(Range("E" & i).Offset(0, x).Formula) > 0 ' repeat until first empty cell in column A With rs .AddNew ' create a new record .Fields("Products") = Range("C" & i).Value .Fields("Mapping") = Range("A1").Value .Fields("Region") = Range("B2").Value .Fields("ARPU") = Range("D" & i).Value .Fields("Quarter_F") = Range("E3").Offset(0, x).Value .Fields("Year_F") = Range("E2").Offset(0, x).Value .Fields("Units_F") = Range("E" & i).Offset(0, x).Value .Update ' stores the new record End With x = x + 1 Loop Next i rs.Close Set rs = Nothing cn.Close Set cn = Nothing End Sub 

这段代码到目前为止我所要做的就是这些。 我知道要添加一个片断，将检查logging是否存在基于4个规则：Products，Region，Quarter_F和Year_F如果它们匹配，它应该更新另一个字段（Units_F，ARPU）。 如果没有，它应该正确运行代码并创build一个新的logging。

您的帮助将非常感激，我被困在这里，并没有看到如何离开。

谢谢

Answer 1

我有一个Excel电子表格，从单元格A1开始，具有以下数据

 product variety price bacon regular 3.79 bacon premium 4.89 bacon deluxe 5.99 

我在我的Access数据库中有一个名为“PriceList”的表，其中包含以下数据

 product variety price ------- ------- ----- bacon premium 4.99 bacon regular 3.99 

下面的Excel VBA将更新现有的“正常”和“高级”的新价格的访问logging，并在表中添加一个“豪华”的新行：

 Public Sub UpdatePriceList() Dim cn As ADODB.Connection, rs As ADODB.Recordset Dim sProduct As String, sVariety As String, cPrice As Variant ' connect to the Access database Set cn = New ADODB.Connection cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _ "Data Source=C:\Users\Gord\Desktop\Database1.accdb;" ' open a recordset Set rs = New ADODB.Recordset rs.Open "PriceList", cn, adOpenKeyset, adLockOptimistic, adCmdTable Range("A2").Activate ' row 1 contains column headings Do While Not IsEmpty(ActiveCell) sProduct = ActiveCell.Value sVariety = ActiveCell.Offset(0, 1).Value cPrice = ActiveCell.Offset(0, 2).Value rs.Filter = "product='" & sProduct & "' AND variety='" & sVariety & "'" If rs.EOF Then Debug.Print "No existing record - adding new..." rs.Filter = "" rs.AddNew rs("product").Value = sProduct rs("variety").Value = sVariety Else Debug.Print "Existing record found..." End If rs("price").Value = cPrice rs.Update Debug.Print "...record update complete." ActiveCell.Offset(1, 0).Activate ' next cell down Loop rs.Close Set rs = Nothing cn.Close Set cn = Nothing End Sub 

Answer 2

写完这些之后，我才意识到你使用的是VBA，所以我的答案是行不通的。 但是你应该能够跟随正在发生的事情。 这是想法。 而对于VBA集合有一个看看这个：

VBA集合

  // First build your list Dim myRecords As New Collection For i = 4 To 16 x = 0 Do While Len(Range("E" & i).Offset(0, x).Formula) > 0 var list = from t in myRecords where t.Products == Range("C" & i).Value && t.Region == Range("B2").Value && t.Quarter == Range("E3").Offset(0, x).Value && t.Year == Range("E2").Offset(0, x).Value select t; var record = list.FirstOrDefault(); if (record == null) { // a record with your key doesnt exist yet. this is a new record so add a new one to the list record = new CustomObject(); record.Products = Range("C" & i).Value; // etc. fill in the rest myRecords.Add(record); } else { // we found this record base on your key, so let's update record.Units += Range("E" & i).Offset(0, x).Value; } x = x + 1 Loop Next i // Now loop through your custom object list and insert into database