这样的事情应该可以工作。
在示例中仅在调试器的即时窗格中打印 SQL。由于 OP 已经熟悉从数据库中读取数据，因此将其更新留给 OP。
更新到实际更新数据库。
下面显示的代码应该在包含数据的工作表的工作表模块中。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rChangableData As Range
Dim rUpdatedData As Range
' Column headings A1, B1, C1
' CustomerId in Column A
' Range of data that can affect the change B2:C100
' This would be better implemented as a named range,
' but it is less transparent in the source code what it refers to
' * Simply entering a CustomerId, does not add a row
Set rChangableData = Me.Range("B2:C100")
' rUpdatedData is the range of changed data (Target),
' intersecting with the range of changable data (rChangeableData).
' If the two ranges do not intersect, rUpdatedData is Nothing and the event can be ignored
Set rUpdatedData = Intersect(rChangableData, Target)
If Not rUpdatedData Is Nothing Then
' Iterate over the range of changed data
' Obtain the CustomerId, FirstName and LastName values from the worksheet
' Provide to functions to perform the updates
' Also added a delete function where there is a CustomerId and no values for FirstName and LastName
Dim numRows As Long
Dim rowcounter As Long
Dim firstRow As Long
Dim lastRow As Long
Dim result As Integer
' Since the code needs to refer back to data on the worksheet,
' it keeps track of the row numbers in on the worksheet, rather than the changed data
numRows = rUpdatedData.Rows.Count
firstRow = Target.Row - rChangableData.Row + 1
rowcounter = firstRow
lastRow = firstRow + numRows
While rowcounter < lastRow
Dim CustomerId As Long
Dim FirstName As String
Dim LastName As String
Dim sql As String
CustomerId = rChangableData.Offset(0, -1).Cells(rowcounter, 1)
FirstName = rChangableData.Cells(rowcounter, 1)
LastName = rChangableData.Cells(rowcounter, 2)
If Trim(CustomerId) <> "" And Trim(FirstName) <> "" And Trim(LastName) <> "" Then
' The data has changed and there are non-blank values for CustomerId, FirstName and LastName;
' insert or update the customer
result = Customer_Update(CustomerId, FirstName, LastName)
If result = 0 Then
MsgBox "No rows were inserted or updated.", vbExclamation, "Customer Update"
Else
If result > 1 Then
MsgBox "Multiple rows were updated.", vbExclamation, "Customer Update"
End If
End If
Else
If Trim(CustomerId) <> "" And Trim(FirstName) = "" And Trim(LastName) = "" Then
' The data has changed and there is a non-blank value for CustomerID and
' blank values for FirstName and LastName;
' delete the customer
Customer_Delete CustomerId
If result = 0 Then
MsgBox "No rows were deleted", vbExclamation, "Customer Delete"
End If
End If
End If
rowcounter = rowcounter + 1
Wend
End If
End Sub
下面显示的代码应位于同一 VBA 项目中的单独模块中。此代码处理连接和更新客户。
Option Explicit
Private Function CreateSQLConnection() As ADODB.Connection
' Create an ADODB Connection.
' Settings depend on your own specific environment
Dim provider As String
Dim source As String
Dim database As String
Dim credentials As String
Dim connectionString As String
Dim sqlConn As ADODB.Connection
' Original Connection String
' "Provider=SQLOLEDB;Data Source=AUSWIDECUSTOMERS\SQL2012;Initial Catalog=Customers;Integrated Security=SSPI;"
provider = "SQLOLEDB"
source = "AUSWIDECUSTOMERS\SQL2012"
database = "Customers"
credentials = "Integrated Security=SSPI"
connectionString = "" & _
"Provider=" & provider & ";" & _
"Data Source=" & source & ";" & _
"Initial Catalogue=" & database & ";" & _
credentials & ";"
Set sqlConn = New ADODB.Connection
sqlConn.Open connectionString
sqlConn.DefaultDatabase = database
Set CreateSQLConnection = sqlConn
End Function
Public Function Customer_Update(CustomerId As Long, FirstName As String, LastName As String) As Integer
' Update or Insert a customer.
' * Creates a connection
' * Performs an update to the customer
' * Checks the number of rows affected
' * If no rows are affected, inserts the customer instead
Dim sqlConn As ADODB.Connection
Dim sqlCmd As ADODB.Command
Dim sqlParam As ADODB.Parameter
Dim rowsUpdated As Long
Set sqlConn = CreateSQLConnection()
Set sqlCmd = New ADODB.Command
sqlCmd.ActiveConnection = sqlConn
sqlCmd.CommandType = adCmdText
sqlCmd.CommandText = "update customer set FirstName = ?, LastName = ? where CustomerId = ?"
sqlCmd.Parameters.Append sqlCmd.CreateParameter("FirstName", adVarChar, adParamInput, Size:=255, Value:=FirstName)
sqlCmd.Parameters.Append sqlCmd.CreateParameter("LastName", adVarChar, adParamInput, Size:=255, Value:=LastName)
sqlCmd.Parameters.Append sqlCmd.CreateParameter("CustomerId", adInteger, adParamInput, Value:=CustomerId)
sqlCmd.Execute recordsAffected:=rowsUpdated
Set sqlCmd = Nothing
Customer_Update = Handle_UpdateInsertDeleteRows(rowsUpdated)
If Customer_Update = 0 Then
Dim rowsInserted As Long
Set sqlCmd = New ADODB.Command
sqlCmd.ActiveConnection = sqlConn
sqlCmd.CommandType = adCmdText
sqlCmd.CommandText = "insert into customer ( CustomerId, FirstName, LastName ) values ( ?, ?, ? )"
sqlCmd.Parameters.Append sqlCmd.CreateParameter("CustomerId", adInteger, adParamInput, Value:=CustomerId)
sqlCmd.Parameters.Append sqlCmd.CreateParameter("FirstName", adVarChar, adParamInput, Size:=255, Value:=FirstName)
sqlCmd.Parameters.Append sqlCmd.CreateParameter("LastName", adVarChar, adParamInput, Size:=255, Value:=LastName)
sqlCmd.Execute recordsAffected:=rowsInserted
Customer_Update = Handle_UpdateInsertDeleteRows(rowsInserted)
Set sqlCmd = Nothing
End If
sqlConn.Close
Set sqlConn = Nothing
End Function
Public Function Customer_Delete(CustomerId As Long) As Integer
' Delete a customer.
' * Creates a connection
' * Performs an delete on the customer table
Dim sqlConn As ADODB.Connection
Dim sqlCmd As ADODB.Command
Dim sqlParam As ADODB.Parameter
Dim rowsDeleted As Long
Set sqlConn = CreateSQLConnection()
Set sqlCmd = New ADODB.Command
sqlCmd.ActiveConnection = sqlConn
sqlCmd.CommandType = adCmdText
sqlCmd.CommandText = "delete customer where CustomerId = ?"
sqlCmd.Parameters.Append sqlCmd.CreateParameter("CustomerId", adInteger, adParamInput, Value:=CustomerId)
sqlCmd.Execute recordsAffected:=rowsDeleted
Set sqlCmd = Nothing
Customer_Delete = Handle_UpdateInsertDeleteRows(rowsDeleted)
sqlConn.Close
Set sqlConn = Nothing
End Function
Private Function Handle_UpdateInsertDeleteRows(recordsAffected As Long) As Integer
' Returns:
' * 0 for no rows
' * 1 for single row
' * 2 for multi row
Select Case recordsAffected
Case Is <= 0
Handle_UpdateInsertDeleteRows = 0
Case Is = 1
Handle_UpdateInsertDeleteRows = 1
Case Is > 1
Handle_UpdateInsertDeleteRows = 2
End Select
End Function