Excel 比较日器

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
  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值