vba-信息填报表内容自动录入汇总表

m0_66437880

于 2024-08-22 21:54:10 发布

阅读量288

点赞数 3

文章标签： excel

本文链接：https://blog.csdn.net/m0_66437880/article/details/141429087

版权

用于业绩填报使用。员工在 '填报表'sheet 中录入业绩数据，点击提交，然后公式表中自动登记每一天每个人的业绩数据。可多行录入，点击提交后会逐条自动排查信息是否有误，会进行提示，并录入到汇总表中。

填报表sheet

单量汇总表-公式sheet

功能：

1. 点击提交，填报日期自动跟汇总表第一行比对，有误自动提示并标黄。

2. 点击提交，姓名、店铺会自动跟信息维护列（J列、K列）比对，有误自动提示并标黄。

3. 点击提交，当姓名跟店铺对应关系错误，会自动提示并标黄。

4. 点击提交，当信息已经录入过，会自动提示是否需要覆盖数据。

vba源码（我这里是有两个汇总表，一个单量，一个链接数，结构一样，所以有些代码是重复的，重复的下标2，查看的时候注意别看错）

maxColumn这里我要单拎一下，因为汇总表的行坐标是根据姓名和店铺一起定位的，所以两个坐标取最大的那个行号。这里有个bug，如果两个人工作交接，都维护1家店的话，这就会报错了，正在解决中。

Sub SubmitDataWithValidationAndConfirmation()
    Dim wsInput As Worksheet, wsOutput As Worksheet, wsOutput2 As Worksheet
    Dim lastRowInput As Long, lastRowInputJ As Long, lastRowInputK As Long
    Dim i As Integer
    Dim dateToCheck As String
    Dim nameToCheck As String
    Dim shopToCheck As String
    Dim dateRow As Variant, nameColumn As Variant, shopColumn As Variant
    Dim cellValue As Variant, cellValue2 As Variant
    Dim confirm As Integer, confirm2 As Integer
    Dim nameCell As Range, shopCell As Range, dateCell As Range, dateCell2 As Range
    Dim maxColumn As Long, maxColumn2 As Long
    Dim nameyanzheng As String, shopyanzheng As String
    Dim nameyanzheng2 As String, shopyanzheng2 As String

    ' 设置工作表引用
    Set wsInput = ThisWorkbook.Sheets("填报表")
    Set wsOutput = ThisWorkbook.Sheets("单量汇总表-公式")
    Set wsOutput2 = ThisWorkbook.Sheets("链接汇总表-公式")

    ' 找到填报表的最后一个数据行
    lastRowInput = wsInput.Cells(wsInput.Rows.Count, "A").End(xlUp).Row
    lastRowInputJ = wsInput.Cells(wsInput.Rows.Count, "J").End(xlUp).Row
    lastRowInputK = wsInput.Cells(wsInput.Rows.Count, "K").End(xlUp).Row

    ' 遍历填报表中的每一行
    For i = 2 To lastRowInput ' 假设第一行是标题行
        ' 获取填报信息
        dateToCheck = Format(wsInput.Cells(i, "A").Value, "M/D") ' 获取日期
        nameToCheck = wsInput.Cells(i, "B").Value ' 获取姓名
        shopToCheck = wsInput.Cells(i, "C").Value ' 获取店铺名

        ' 检查姓名是否存在于信息维护列
        Set nameCell = wsInput.Range("J2:J" & lastRowInputJ).Find(What:=nameToCheck, LookIn:=xlValues, LookAt:=xlWhole)

        ' 检查店铺是否存在于信息维护列
        Set shopCell = wsInput.Range("K2:K" & lastRowInputK).Find(What:=shopToCheck, LookIn:=xlValues, LookAt:=xlWhole)

        ' 检查日期是否存在于单量汇总表-公式sheet中的第一行
        Set dateCell = wsOutput.Range("C1:SS1").Find(What:=dateToCheck, LookIn:=xlValues, LookAt:=xlWhole)

        ' 检查日期是否存在于链接汇总表-公式sheet中的第一行
        Set dateCell2 = wsOutput2.Range("C1:SS1").Find(What:=dateToCheck, LookIn:=xlValues, LookAt:=xlWhole)

        ' 如果找到匹配的姓名和店铺
        If Not nameCell Is Nothing Then
            If Not shopCell Is Nothing Then
                If Not dateCell Is Nothing Then
                                        If Not dateCell2 Is Nothing Then
                                            ' 单量汇总表处理
                    nameColumn = Application.WorksheetFunction.Match(nameToCheck, wsOutput.Columns("A"), 0)
                    shopColumn = Application.WorksheetFunction.Match(shopToCheck, wsOutput.Columns("B"), 0)
                    dateRow = Application.WorksheetFunction.Match(CDbl(Format(dateToCheck, "0.00")), wsOutput.Rows(1), 0)

                    maxColumn = Application.WorksheetFunction.Max(nameColumn, shopColumn)
                    nameyanzheng = wsOutput.Cells(maxColumn, "A").Value
                    shopyanzheng = wsOutput.Cells(maxColumn, "B").Value

                    If maxColumn > 0 And dateRow > 0 And nameyanzheng = nameToCheck And shopyanzheng = shopToCheck Then
                        cellValue = wsOutput.Cells(maxColumn, dateRow).Value
                        If Trim(cellValue) <> "" Then
                            confirm = MsgBox("已存在数据，单量：" & cellValue & vbCrLf & "是否覆盖？", vbYesNo, "确认提交")
                            If confirm = vbYes Then
                                wsOutput.Cells(maxColumn, dateRow).Value = wsInput.Cells(i, "D").Value ' 追加单量
                            End If
                        Else
                            wsOutput.Cells(maxColumn, dateRow).Value = wsInput.Cells(i, "D").Value ' 追加单量
                        End If
                    Else
                        MsgBox "错误：姓名'" & nameToCheck & "' 店铺 '" & shopToCheck & "'对应关系错误，未在'单量汇总表-公式' sheet中找到。"
                        wsInput.Cells(i, "B").Interior.Color = RGB(255, 255, 0) ' 将姓名单元格标黄
                        wsInput.Cells(i, "C").Interior.Color = RGB(255, 255, 0) ' 将店铺单元格标黄
                    End If

                    ' 链接汇总表处理
                    nameColumn = Application.WorksheetFunction.Match(nameToCheck, wsOutput2.Columns("A"), 0)
                    shopColumn = Application.WorksheetFunction.Match(shopToCheck, wsOutput2.Columns("B"), 0)
                    dateRow = Application.WorksheetFunction.Match(CDbl(Format(dateToCheck, "0.00")), wsOutput2.Rows(1), 0)

                    maxColumn2 = Application.WorksheetFunction.Max(nameColumn, shopColumn)
                    nameyanzheng2 = wsOutput2.Cells(maxColumn2, "A").Value
                    shopyanzheng2 = wsOutput2.Cells(maxColumn2, "B").Value

                    If maxColumn2 > 0 And dateRow > 0 And nameyanzheng2 = nameToCheck And shopyanzheng2 = shopToCheck Then
                        cellValue2 = wsOutput2.Cells(maxColumn2, dateRow).Value
                        If Trim(cellValue2) <> "" Then
                            confirm2 = MsgBox("已存在数据，链接数：" & cellValue2 & vbCrLf & "是否覆盖？", vbYesNo, "确认提交")
                            If confirm2 = vbYes Then
                                wsOutput2.Cells(maxColumn2, dateRow).Value = wsInput.Cells(i, "E").Value ' 追加链接数
                            End If
                        Else
                            wsOutput2.Cells(maxColumn2, dateRow).Value = wsInput.Cells(i, "E").Value ' 追加链接数
                        End If
                    Else
                        MsgBox "错误：姓名'" & nameToCheck & "' 店铺 '" & shopToCheck & "'对应关系错误，未在'链接汇总表-公式' sheet中找到。"
                        wsInput.Cells(i, "B").Font.Color = RGB(255, 0, 0) ' 将字体颜色设置为红色
                                                wsInput.Cells(i, "B").Font.Bold = True ' 将字体设置为加粗
                                                wsInput.Cells(i, "C").Font.Color = RGB(255, 0, 0) ' 将字体颜色设置为红色
                                                wsInput.Cells(i, "C").Font.Bold = True ' 将字体设置为加粗
                    End If
                                    Else
                    MsgBox "错误：日期 '" & dateToCheck & "' 未在'链接汇总表-公式' sheet中找到。"
                    wsInput.Cells(i, "A").Font.Color = RGB(255, 0, 0) ' 将字体颜色设置为红色
                                        wsInput.Cells(i, "A").Font.Bold = True ' 将字体设置为加粗
                End If
                                        
                Else
                    MsgBox "错误：日期 '" & dateToCheck & "' 未在'单量汇总表-公式' sheet中找到。"
                    wsInput.Cells(i, "A").Interior.Color = RGB(255, 255, 0) ' 将日期单元格标黄
                End If
            Else
                MsgBox "错误：店铺 '" & shopToCheck & "' 未在信息维护列中找到。"
                wsInput.Cells(i, "C").Interior.Color = RGB(255, 255, 0) ' 将店铺单元格标黄
            End If
        Else
            MsgBox "错误：姓名 '" & nameToCheck & "' 未在信息维护列中找到。"
            wsInput.Cells(i, "B").Interior.Color = RGB(255, 255, 0) ' 将姓名单元格标黄
        End If
    Next i
End Sub