Excel 比较日器

wpyok168

已于 2023-08-21 13:30:10 修改

阅读量131

点赞数

文章标签：大数据

于 2022-06-27 17:10:48 首次发布

本文链接：https://blog.csdn.net/wpyok168/article/details/125487792

版权

Private Sub CheckDate_Click()
Dim cd
cd = YQCheckDate()
End Sub

Public Function YQCheckDate()
Dim i As Integer, r As Integer, num As Integer
Dim T1, T2, T3 As Date
Dim lie As Integer

lie = 15 '列号15 即 O 列
num = 0 '统计次校日期到期数量

r = Range("o65536").End(xlUp).Row '统计o列有数据的单元格个数有多少

T2 = Now() '当前日期


'T1 = VBA.DateSerial(2022, 6, 26)'日期转换
'T1 = Range("A1").Value'获取单元格的值

'循环单元格数据
For i = 1 To r

T1 = Cells(i, lie)

If (IsEmpty(T1)) Then
    Cells(i, lie).Interior.Pattern = xlNone '清除背景色
    
Else
    If (IsDate(T1)) Then
        T3 = T1 - 30 '次校日期往前30天
        If (T2 > T3) Then
            'MsgBox ("仪器校验日期过期了")
            Cells(i, lie).Interior.Color = 255 '填充红色
            num = num + 1
        Else
           Cells(i, lie).Interior.Pattern = xlNone '清除背景色
        End If
    End If
End If

Next

If (num > 0) Then
    Dim result
    result = MsgBox("总共有" + Str(num) + "个设备到期，需安排校正！", vbExclamation)
End If
End Function

excel 函数公式：返回由文本字符串指定的引用
=INDIRECT(“k_”&REPLACE(N6,5,1,“_”))

Private Sub CommandButton1_Click()
'updateby Extendoffice
    Dim xCount As Variant
    Dim xScreen As Boolean
    Dim I As Long
    Dim S As Long
    On Error Resume Next
LInput:
    xCount = Application.InputBox("请输入要求打印的份数:", "自动生产序列号")
    If TypeName(xCount) = "Boolean" Then Exit Sub
    If (xCount = "") Or (Not IsNumeric(xCount)) Or (xCount < 1) Then
        MsgBox "输入错误，请重新输入", vbInformation, "自动生产序列号"
        GoTo LInput
    Else
        xScreen = Application.ScreenUpdating
        Application.ScreenUpdating = False
        
        Application.Dialogs(xlDialogPrinterSetup).Show
        
        For I = 1 To xCount
            'ActiveSheet.Range("A1").Value = " Company-00" & I
            'ActiveSheet.Range("K6").Value = I
            'S = Len(ActiveSheet.Range("K6").Value)
            S = Len(Str(I))
            Select Case S
            Case 2
                ActiveSheet.Range("C5").Value = ActiveSheet.Range("K5").Value & "000" & I
            Case 3
                ActiveSheet.Range("C5").Value = ActiveSheet.Range("K5").Value & "00" & I
            Case 4
                ActiveSheet.Range("C5").Value = ActiveSheet.Range("K5").Value & "0" & I
            Case Else
                ActiveSheet.Range("C5").Value = ActiveSheet.Range("K5").Value & I
            End Select
            
            ActiveSheet.PrintOut
            'Application.Dialogs(xlDialogPrinterSetup).Show
            'ActiveSheet.PrintPreview
            
            
        Next
        ActiveSheet.Range("C5").ClearContents
        Application.ScreenUpdating = xScreen
    End If
End Sub