10

我一直在尝试到处寻找答案，但我在 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

到目前为止，这段代码正是我想要的。我知道要添加一个将根据 4 个规则检查记录是否存在的部分：产品、区域、季度_F 和年_F 如果匹配这些，它应该更新另一个字段（单位_F，ARPU）。如果没有，它应该正确运行代码并创建新记录。

非常感谢您的帮助，我被困在这里，不知道如何出去。

谢谢

4

3 回答 3

8

I have an Excel spreadsheet with the following data starting in cell A1

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

I have a Table named "PriceList" in my Access database which contains the following data

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

The following Excel VBA will update the existing Access records with the new prices for "regular" and "premium", and add a new row in the table for "deluxe":

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
于 2013-03-29T21:59:23.090 回答
0

写完之后，我才意识到您正在使用 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
于 2013-03-29T19:19:00.910 回答
0

我没有足够的声誉来评论上述答案之一。该解决方案非常好，但是如果您在一行中有大量记录要循环，则将所有内容都包含在一个循环中会更容易。我还将我的数据放在 Excel 表中（但如果您只有一个非动态范围，请将其作为一个范围输入）。

Set LO = wb.Worksheets("Sheet").ListObjects("YOUR TABLE NAME")
rg = LO.DataBodyRange
'All of the connection stuff from above that is excellent
For x = LBound(rg) To UBound(rg)

'Note that first I needed to find the row in my table containing the record to update
'And that I also got my user to enter all of the record info from a user form
'This will mostly work for you regardless, just get rid of the L/Ubound and search
'Your range for the row you will be working on

    If rg(x,1) = Me.cmbProject.Value Then
        working_row = x
        Exit For
    End If
Next
For i = 2 To 17 ' This would be specific to however long your table is, or another range
'argument would work just as well, I was a bit lazy here
    col_names(i-1) = LO.HeaderRowRange(i) 'Write the headers from table into an array
    Data(i-1) = Me.Controls("Textbox" & i).Value 'Get the data the user entered
Next i
'Filter the Access table to the row you will be entering the data for. I didn't need
'Error checking because users had to select a value from a combobox
rst.Filter = "[Column Name] ='" & "Value to filter on (for me the combobox val)"
For i = 1 To 16 'Again using a len(Data) would work vs. 16 hard code
    rst(col_names(i)).Value = Data(i)
Next i

就是这样-然后我刚刚关闭了数据库/连接等，并给我的用户一条消息，说数据已被写入。

您真正需要在这里注意的唯一一件事是我的用户表单尚未（尚未）合并数据类型检查，但这是我的下一段代码。否则，当您打开它时，您可能会从 Access 或一些看起来很糟糕的数据中获得异常！

于 2018-01-29T23:58:16.957 回答