VBA收集-不具合一览管理

// 处理完了按钮
Sub BackLog_Click()
    If ActiveCell.Row > 4 Then
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 14).Value = "処理済み"
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 15).Value = Now
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 16).Value = "完了"
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 18).Value = Now
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 10).Value = Now
        Dim checkUser As String
        checkUser = ""
        checkUser = Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 20).Value
        If checkUser = "" And Range("N1").Value = "" Then
                checkUser = "隋"
            Else
                If checkUser = "" Then
                    checkUser = Range("N1").Value
                End If
        End If
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 19).Value = checkUser
    End If
End Sub

// 判断值是否为空值
Function CheckEmpty(str) As Boolean
Dim ret As Boolean
ret = False
If str = "" Or LTrim(RTrim(str)) = "" Then
ret = True
End If
CheckEmpty = ret
End Function

// 实装完成处理中按钮
Sub ProcessDone_Click()
    If ActiveCell.Row > 4 Then
        If MsgBox("「完了予定日」、「原因区分」、「対応工数」項目を確認の上、修正完了しましょうか。", vbOKCancel + vbQuestion, "修正完了操作") = vbOK Then
            Dim doneDate As String
            doneDate = Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 10).Value
            Dim doneType As String
            doneType = Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 12).Value
            Dim doneCa As String
            doneCa = Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 13).Value
            If CheckEmpty(doneDate) Or CheckEmpty(doneType) Or CheckEmpty(doneCa) Then
                MsgBox "「完了予定日」、「原因区分」、「対応工数」項目がどちらか空白できない、追記してください。", vbCritical
            Else
                Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 16).Value = "検収中"
            End If
        End If
    End If
End Sub

// 处理中按钮
Sub BackLogReturn_Click()
   If ActiveCell.Row > 4 Then
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 15).Value = Now
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 16).Value = "修正中"
        If Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 9).Value = "高" Then
            ProcHigh_click
        ElseIf Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 9).Value = "中" Then
            ProcMid_click
        Else
            ProcLow_click
        End If
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 14).Value = "処理中"
    End If
End Sub

// 设定对应级别为【高】
Sub ProcHigh_click()
    If ActiveCell.Row > 4 Then
        Dim highVal As String
        If Range("G1").Value = "" Then
                highVal = 2
            Else
                highVal = Range("G1").Value
        End If
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 9).Value = "高"
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 6).Value = Format(Now, "yyyy/M/d")
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 10).Value = newDate(Now, highVal)
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 14).Value = "未対応"
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 16).Value = "修正中"
        procePer
    End If
End Sub

// 设定对应级别为【未手配】
Sub procePer()
Dim procePer As String
        procePer = Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 20).Value
        If CheckEmpty(procePer) Then
            Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 20).Value = "未手配"
        End If
End Sub

// 设定对应级别为【中】
Sub ProcMid_click()
    If ActiveCell.Row > 4 Then
        Dim highVal As String
        If Range("H1").Value = "" Then
                highVal = 4
            Else
                highVal = Range("H1").Value
        End If
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 9).Value = "中"
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 6).Value = Format(Now, "yyyy/M/d")
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 10).Value = newDate(Now, highVal)
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 14).Value = "未対応"
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 16).Value = "修正中"
        procePer
    End If
End Sub

// 设定对应级别为【低】
Sub ProcLow_click()
    If ActiveCell.Row > 4 Then
        Dim highVal As String
        If Range("I1").Value = "" Then
                highVal = 7
            Else
                highVal = Range("I1").Value
        End If
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 9).Value = "低"
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 6).Value = Format(Now, "yyyy/M/d")
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 10).Value = newDate(Now, highVal)
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 14).Value = "未対応"
        Cells(ActiveCell.Row, ActiveCell.Column - ActiveCell.Column + 16).Value = "修正中"
        procePer
    End If
End Sub

// 判断日期是否为周六或周日，若为休息日则自动跳过，反回增加后的日期
Function newDate(vDate, val) As Date
    Dim retDate
    For i = 1 To val
        If retDate = "" Then
            retDate = vDate + 1
        Else
            retDate = retDate + 1
        End If
        If Weekday(retDate) = 7 Or Weekday(retDate) = 1 Then
            retDate = doProc(retDate)
        End If
    Next i
    newDate = retDate
End Function

// 递归判断指定日期是否周六或周日
Function doProc(inDate) As Date
Dim newDate
newDate = inDate
Do
    newDate = newDate + 1
Loop Until Weekday(newDate) <> 7 And Weekday(newDate) <> 1
doProc = newDate
End Function