本章节是继中台数据库后的第二章，中台数据库搭建完成，需要销售填充数据。其实有了最开始踩的坑，做起销售系统就的心应手了。
功能设计： 点击单元格–>弹出弹窗–> 填写相关信息 –> 提交
获取最新的分配数据。
卡点问题：这个部分遇到的卡点就是如何把信息分成两个部分发送数据库，因为销售数据，回访中的数据是要逐次添加的，但是跟进结果的数据只有一次，这是放在一起填写，但是拆分成了两个表。在设计窗体的时候花了一些功夫。
另外，在数据更新上面也花了些功夫，就是，数据双击后，跟进结构的数据需要再更新，设计这个部分也花了不少时间。
上代码
窗体设计：
第二步：双击单元格，弹出窗体，并把已有数据填入chackBOX
再客户跟进表的VBA里打开
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim selectedRow As Range
Dim dataRange As Range
Dim textBoxIndex As Integer
'checkBOX数据
Dim checkBoxRange As Range
Dim checkBoxIndex As Integer
Dim checkBoxColumnRange As Range
Dim frm As UserForm1
Dim columnRange As Range
If Not Intersect(Target, Range("H:H")) Is Nothing Then
' 判断选定的单元格是否在列 H 中
' 如果是，则弹出弹窗
If Target.Cells.Count > 1 Then Exit Sub ' 检查双击的目标是否为单个单元格
Set selectedRow = Target.EntireRow ' 获取当前选中单元格所在的行
' 设置数据范围为选中行的某几列的数据，包括空单元格
Set columnRange = selectedRow.Parent.Range("H:I,M:M,C:C")
Set dataRange = Intersect(selectedRow, columnRange)
' 检查是否存在数据
If dataRange Is Nothing Then Exit Sub
'检查checkbox 数据，初始化checkbox
Set checkBoxColumnRange = selectedRow.Parent.Range("T:W")
Set checkBoxRange = Intersect(selectedRow, checkBoxColumnRange)
' 检查是否存在数据
If checkBoxRange Is Nothing Then Exit Sub
' 创建并显示用户窗体
Set frm = New UserForm1
' 将数据依次放入窗体的TextBox中
textBoxIndex = 1
For Each cell In dataRange
frm.Controls("TextBox" & textBoxIndex).Text = cell.value
textBoxIndex = textBoxIndex + 1
Next cell
checkBoxIndex = 1
For Each checkCells In checkBoxRange
If checkCells = "是" Then
frm.Controls("CheckBox" & checkBoxIndex).value = True
End If
'MsgBox checkCells
checkBoxIndex = checkBoxIndex + 1
Next checkCells
frm.Show
' 取消双击事件的默认操作
Cancel = True
Set columnRange = Nothing
Set dataRange = Nothing
End If
End Sub第三步，窗体代码
3.1 初始化变量
'初始化数组变量
Option Explicit
Dim cnn As ADODB.connection
Dim rs As ADODB.Recordset
'数组变量
Dim checkValues(1 To 4, 1 To 2) As Variant
Dim commboxValues(1 To 6, 1 To 2) As Variant
Sub InitCheckArray()
checkValues(1, 1) = Me.CheckBox1.value
checkValues(1, 2) = "加微信"
checkValues(2, 1) = Me.CheckBox2.value
checkValues(2, 2) = "加公众号"
checkValues(3, 1) = Me.CheckBox3.value
checkValues(3, 2) = "是否应约峰会"
checkValues(4, 1) = Me.CheckBox4.value
checkValues(4, 2) = "签约"
'checkValues(5, 1) = Me.ComboBox2.value
'checkValues(5, 2) = "意向等级"
'checkValues(6, 1) = Me.ComboBox3.value
'checkValues(6, 2) = "是否与校长建联"
End Sub
Sub InitCommboxArray()
commboxValues(1, 1) = Me.TextBox5.value
commboxValues(1, 2) = "回访时间"
commboxValues(2, 1) = Me.ComboBox1.value
commboxValues(2, 2) = "触达结果"
commboxValues(3, 1) = Me.TextBox6.value
commboxValues(3, 2) = "接通部门"
commboxValues(4, 1) = Me.TextBox7.value
commboxValues(4, 2) = "情况说明"
commboxValues(5, 1) = Me.ComboBox3.value
commboxValues(5, 2) = "意向等级"
commboxValues(6, 1) = Me.ComboBox2.value
commboxValues(6, 2) = "是否与校长建联"
End Sub3.2 初始化窗体，原有的数据填充进窗体
'初始化窗体
Private Sub UserForm_Initialize()
'初始化数据
Dim i As Integer
Dim ws As Worksheet
Dim dataRange As Range
Dim dataValues As Variant
Dim cell As Excel.Range
' 设置工作表对象
Set ws = ThisWorkbook.Sheets("设置")
' 定义要获取数据的区域范围
Set dataRange = ws.Range("B2:D7")
Me.ComboBox1.Clear
' 将数据填充到 ComboBox1
For Each cell In dataRange.Columns(1).Cells
If cell.value <> "" Then
Me.ComboBox1.AddItem cell.value
End If
Next cell
' 将数据填充到 ComboBox2
Me.ComboBox2.Clear
For Each cell In dataRange.Columns(2).Cells
If cell.value <> "" Then
Me.ComboBox2.AddItem cell.value
End If
Next cell
' 将数据填充到 ComboBox3
Me.ComboBox3.Clear
For Each cell In dataRange.Columns(3).Cells
If cell.value <> "" Then
Me.ComboBox3.AddItem cell.value
End If
Next cell
ComboBox1.ListIndex = 0
ComboBox2.ListIndex = 0
ComboBox3.ListIndex = 0
Me.TextBox5.value = Now()
Me.TextBox1.Enabled = False
Me.TextBox3.Enabled = False
Me.TextBox5.Enabled = False
Me.TextBox4.Enabled = False
Set ws = Nothing
Set dataRange = Nothing
End Sub'提交数据
Private Sub CommandButton2_Click()
Dim exists As Boolean
Dim sql As String
Call 连接数据库
sql = "SELECT COUNT(*) FROM 跟进结果 WHERE 学校名称id = " & Me.TextBox4.value
Set rs = New ADODB.Recordset
rs.Open sql, cnn, 2, 2
exists = (rs.Fields(0).value > 0)
'释放对象变量空间
rs.Close: Set rs = Nothing
cnn.Close: Set cnn = Nothing
Call 回访更新(Me.TextBox4.value)
If exists Then
' 存在记录，执行更新操作
UpdateData (Me.TextBox4.value)
Else
InsertData (Me.TextBox4.value)
End If
End SubSub 回访更新(id As Integer)
' 执行插入操作的代码
Dim sql As String, i As Integer
Dim filedTable As String, filedValues As String
InitCommboxArray
' 执行更新操作的代码
Call 连接数据库
sql = "INSERT INTO 回访("
For i = 1 To UBound(commboxValues, 1)
filedTable = filedTable & commboxValues(i, 2) & ","
filedValues = filedValues & "'" & commboxValues(i, 1) & "',"
Next i
sql = sql & filedTable & "数据总表id) values(" & filedValues & id & ")"
MsgBox sql
' 添加 WHERE 子句，根据需要修改
Set rs = New ADODB.Recordset
rs.Open sql, cnn, 2, 2
Set rs = Nothing
cnn.Close: Set cnn = Nothing
'Call 跟进结果更新
End Sub' 跟进结果更新数据, 如果存在的化就更新
Sub UpdateData(id As Integer)
Dim sql As String, i As Integer
InitCheckArray
' 执行更新操作的代码
Call 连接数据库
sql = "UPDATE 跟进结果 SET "
For i = 1 To 4
If checkValues(i, 1) = True Then
checkValues(i, 1) = "是"
Else
checkValues(i, 1) = "否"
End If
sql = sql & checkValues(i, 2) & "='" & checkValues(i, 1) & "', "
Next i
sql = Left(sql, Len(sql) - 2) ' 移除最后一个逗号和空格
' 添加 WHERE 子句，根据需要修改
sql = sql & " WHERE 学校名称id=" & id
Set rs = New ADODB.Recordset
rs.Open sql, cnn, 2, 2
Set rs = Nothing
cnn.Close: Set cnn = Nothing
Call 跟进结果更新
Unload Me
End Sub'如果不存在就插入
Sub InsertData(id As Integer)
' 执行插入操作的代码
Dim sql As String, i As Integer
Dim filedTable As String, filedValues As String
InitCheckArray
' 执行更新操作的代码
Call 连接数据库
sql = "INSERT INTO 跟进结果("
For i = 1 To UBound(checkValues, 1)
Dim value As String
If checkValues(i, 1) = True Then
checkValues(i, 1) = "是"
Else
checkValues(i, 1) = "否"
End If
filedTable = filedTable & checkValues(i, 2) & ","
filedValues = filedValues & "'" & checkValues(i, 1) & "',"
Next i
sql = sql & filedTable & "学校名称id) values(" & filedValues & id & ")"
'MsgBox sql
' 添加 WHERE 子句，根据需要修改
Set rs = New ADODB.Recordset
rs.Open sql, cnn, 2, 2
Set rs = Nothing
cnn.Close: Set cnn = Nothing
Call 跟进结果更新
Unload Me
End Sub
'单元格数据更新
Sub 跟进结果更新()
Dim newArray() As Variant
Dim selectedRow As Long
newArray = getNewArray
selectedRow = ActiveCell.row
MsgBox newArray(1)
Dim dataRange As Range
Set dataRange = Range("m:w").Rows(selectedRow)
If Not dataRange Is Nothing Then
' 将数组值写入单元格
dataRange.value = newArray
Else
MsgBox "未找到交叉区域"
End If
Set dataRange = Nothing
End Sub' 数组重组
Function getNewArray() As Variant
Dim valuesArray() As Variant, i As Integer, numRows As Integer, numRows2 As Integer
' 回访数据初次重组
numRows = UBound(commboxValues, 1) + 1
ReDim valuesArray(1 To numRows)
If Me.TextBox3.value = "" Then
Me.TextBox3.value = 0
End If
valuesArray(1) = Me.TextBox3.value + 1
For i = 1 To numRows - 1
valuesArray(i + 1) = commboxValues(i, 1)
Next i
numRows2 = numRows + UBound(checkValues, 1)
ReDim Preserve valuesArray(1 To numRows2)
For i = 1 To UBound(checkValues, 1)
valuesArray(numRows + i) = checkValues(i, 1)
Next i
getNewArray = valuesArray
End Function