小试流程项目管理一


 

Option Explicit
Sub 添加小试流程()
    Dim i, j, ws1, ws2
    '从第三行开始
    i = 3
    j = 2
    '找到序号列中的空行,即找到添加文本的行号
    Set ws1 = Worksheets("总表")
    While ws1.Cells(i, 1) <> ""
        i = i + 1
    Wend
    
    '匹配业务员
    Set ws2 = Worksheets("分工表")
        '循环遍历整张分工表
        While ws2.Cells(j, 1) <> ""
            If ws2.Cells(j, 1) = Cells(3, 1) Then
                ws1.Cells(i, 7) = ws2.Cells(j, 2)
            End If
            j = j + 1
        Wend
        
        '异常处理
        '如果有些单元格没有内容,则提示错误
        If Cells(3, 1) = "" Or Cells(3, 2) = "" Or Cells(3, 3) = "" Or Cells(3, 5) = "" Then
            MsgBox ("请检查!!!")
        Else
            '序号
            ws1.Cells(i, 1) = i - 2
            '物料名称
            ws1.Cells(i, 2) = Cells(3, 1)
            '使用基地
            ws1.Cells(i, 3) = Cells(3, 2)
            '供应商名称
            ws1.Cells(i, 4) = Cells(3, 3)
            '信息概述
            ws1.Cells(i, 5) = Cells(3, 4)
            '流程编号
            ws1.Cells(i, 6) = Cells(3, 5)
            '提示添加成功
            MsgBox ("添加成功")
    
            '文本输入单元格清空
            Range(Cells(3, 1), Cells(3, 5)).ClearContents
        End If
        '如果没有匹配到业务员,则报错
        If ws1.Cells(i, 7) = "" Then
            MsgBox ("没有匹配到业务员,请手动添加")
        End If
End Sub
Sub 添加小试结果()
    Dim i, point, ws1
    i = 3
    '设置一个指针,记录是否有找匹配到流程编号
    point = 0
    Set ws1 = Worksheets("总表")
    While ws1.Cells(i, 6) <> ""
        '如果流程编号匹配
        If ws1.Cells(i, 6) = Cells(7, 1) Then
            '如果检测内容为空,则进行赋值操作
            If ws1.Cells(i, 8) = "" Then
                ws1.Cells(i, 8) = Cells(7, 2)
            Else
            '否则就忽略检测结果赋值,对小试和备注赋值
                ws1.Cells(i, 9) = Cells(7, 3)
                ws1.Cells(i, 10) = ws1.Cells(i, 10) & "/" & Cells(7, 4)
            End If
            point = 1
        End If
        i = i + 1
    Wend
        '如果没有找到流程编号,则报错
        If point = 0 Then
            MsgBox ("流程编号不存在!")
        Else
            '提示添加成功
            MsgBox ("添加成功")
            '清空单元格内容
            Range(Cells(7, 1), Cells(7, 4)).ClearContents
        End If
End Sub

猜你喜欢

转载自blog.csdn.net/weixin_39085109/article/details/88751856