excel 根据单元格值发送变化，自动同步数据至mysql

当excel的第I列数据发生变化时(数据长度大于7)，以B列作为mysql数据更新条件，自动同步I列数据到mysql

环境说明：excel 2010 mysql5.6

excel 数据模板如下：

• cell单元格只发生变化事件,具体代码如下：
  注：多单元格支持粘贴，I列单元格拖拽赋值，单个cell编写值，行复制粘贴等自动同步数据。

Private Sub worksheet_change(ByVal target As Range)

carD = Cells(Selection.Row, 9)

If Selection.Column = 9 Or Len(Trim(carD)) >= 7 Then
  Call updateQk(target)
End If

End Sub

Function updateQk(target)

Application.EnableEvents = False

If Selection.Address Like "*,*" Then

    p = Split(Selection.Address, ",")
    
    For I = LBound(p) To UBound(p)
      q = Split(p(I), "$")
      
      If UBound(q) >= 2 Then
        carNo = Cells(q(2), 9)
        steelNo = Cells(q(2), 2)
        carNo = Mid(UCase(Trim(carNo)), 1, 7)
        
        If Len(Trim(steelNo)) >= 1 And Len(Trim(carNo)) >= 7 Then
          Rem MsgBox steelNo & carNo
          Call updateData(carNo, steelNo)
        End If
        
     End If
     
     Next
ElseIf Selection.Address Like "*:*" Then

    p = Split(Selection.Address, "$")
    
    If UBound(p) >= 4 Then
    
        For I = Replace(p(2), ":", "") To Replace(p(4), ":", "")
          carNo = Cells(I, 9)
          steelNo = Cells(I, 2)
          carNo = Mid(UCase(Trim(carNo)), 1, 7)
          
          If Len(Trim(steelNo)) >= 1 And Len(Trim(carNo)) >= 7 Then
            Rem MsgBox steelNo & carNo
            Call updateData(carNo, steelNo)
          End If
          
        Next
        
     ElseIf UBound(p) >= 2 Then
    
       For I = Replace(p(1), ":", "") To Replace(p(2), ":", "")
          carNo = Cells(I, 9)
          steelNo = Cells(I, 2)
          carNo = Mid(UCase(Trim(carNo)), 1, 7)
          
          If Len(Trim(steelNo)) >= 1 And Len(Trim(carNo)) >= 7 Then
            Rem MsgBox steelNo & carNo
            Call updateData(carNo, steelNo)
          End If
          
        Next
        
    Else
    
        rowId = CInt(target.Row)
        carNo = Cells(rowId, 9)
        steelNo = Cells(rowId, 2)
        carNo = Mid(UCase(Trim(carNo)), 1, 7)
        
        If Len(Trim(steelNo)) >= 1 And Len(Trim(carNo)) >= 7 Then
           Rem MsgBox steelNo & carNo
           Call updateData(carNo, steelNo)
        End If
    
    End If
Else

   rowId = CInt(target.Row)
   carNo = Cells(rowId, 9)
   steelNo = Cells(rowId, 2)
   carNo = Mid(UCase(Trim(carNo)), 1, 7)
   
   If Len(Trim(steelNo)) >= 1 And Len(Trim(carNo)) >= 7 Then
      Rem MsgBox steelNo & carNo
      Call updateData(carNo, steelNo)
   End If
   
End If

Application.EnableEvents = True

End Function

• 连接mysql 更新代码如下：

Function updateData(carNo, steelNo)

Rem 获取数据库连接
Dim conn As ADODB.Connection
Set conn = New ADODB.Connection
conn.ConnectionString = "Driver={MySQL ODBC 5.3 Unicode Driver};Server=127.0.0.1;Port=3306;Database=t;Uid=root;Pwd=1234;OPTION=3;"
conn.Open

carNo = Mid(UCase(Trim(carNo)), 1, 7)

If Len(Trim(steelNo)) >= 1 And Len(Trim(carNo)) >= 7 Then

    Sql = "UPDATE table1 SET carNo= '" & carNo & "'   WHERE  id='" & steelNo & "'"
    
    Rem 执行更新
    conn.Execute (Sql)

End If


Rem 关闭连接
conn.Close: Set conn = Nothing

End Function