有效期限筛选，2位的月份10，11，12不能正确识别，请帮忙看看代码哪里错误。

luchanghai

从日本得来的一个量具管理系统，由于乱码已经转换。但还是有问题，由于本人不懂VBA，还请大神们帮忙看看 代码哪里错误。


问题：进行量具的校正有效期限筛选时，还未到有效期限的10月，11月，12月被筛选为已过有效期限。1~9月份正常。

下面复制几段代码，请先判断一下，如果不能找到原因将上传附件（附件里也有很多日语部分说明）


'機能   ：台帳詳細を台帳フォームに表示する
'引数   ：
'戻り値 ：
'**********************************************************
Public Sub ShowMeasDetails()

Const PROC_NAME As String = "clsMeasDetails/ShowMeasDetails"
   
On Error GoTo MyErr
    With frmLed
        .cboCat.Text = mCat
        .cboGroup.Text = mGroup
        .cboProductName.Text = mProductName
        .txtUsage.Text = mUsage
        .txtCreationDate.Text = FORMAT(mCreationDate, "yyyy/m/d")
        .txtRefeNo.Text = mRefeNo
        .txtUniqueNo1.Text = mUniqueNo1
        .txtUniqueNo2.Text = mUniqueNo2
        .cboManaClass.Text = mManaClass
        .txtCalCycle.Text = mCalCycle
        .txtExpDateYear.Text = FORMAT(mExpDate, "yyyy")
        .txtExpDateMonth.Text = FORMAT(mExpDate, "m")
        '有効期限残月表示
        Call ShowExpDateTimeLimit
        .txtRemarks.Text = mRemarks
        .txtMaker.Text = mMaker
        .txtModel.Text = mModel
        .txtScaleInterVal.Text = mScaleInterval
        .txtMeas.Text = mMeas
        .txtOthersSpec.Text = mOthersSpec
        Call basFrmLed.ShowRefeSign
        Call basFrmLed.ShowStandardCalCycle
    End With
    Exit Sub



Public Sub ShowExpDateTimeLimit()

    With frmLed
        If .txtExpDateYear.Text <> "" And .txtExpDateMonth.Text <> "" And _
           .lblExpDateErr.Visible = False Then
            Dim cColor As clsColor
            
            Set cColor = New clsColor
            .txtTimeLimit.Text = _
                DateDiff("m", Date, DateSerial(.txtExpDateYear.Text, .txtExpDateMonth.Text, 1))
            If .txtTimeLimit.Text >= 0 Then
                .txtTimeLimit.ForeColor = cColor.black
            Else
                .txtTimeLimit.ForeColor = cColor.red
            End If
        End If
    End With

End Sub




'**********************************************************
'機能   ：台帳フォームをクリップボードに登録する
'引数   ：
'戻り値 ：
'**********************************************************
Public Sub RegisterFrmLedInClipBoard()

Const PROC_NAME As String = "basFrmLedClipBoard/RegisterFrmLedInClipBoard"
   
On Error GoTo MyErr
    Dim myWs As Worksheet   'クリップボードシート
    Dim myClm As Long       'クリップボードシート列
    Dim myExpDate As String '有効期限
   
    Set myWs = VBAProject.wsclipBoard
    myClm = GetWsClipBoardClm
    Call ClearClipBoard
    With frmLed
        myWs.Cells(WsClipRow.WsClipRow_CopyDate, myClm).Value = Date & " " & Time
        myWs.Cells(WsClipRow.WsClipRow_RefeNo, myClm).Value = .txtRefeNo.Text
        myWs.Cells(WsClipRow.WsClipRow_UniqueNo1, myClm).Value = .txtUniqueNo1.Text
        myWs.Cells(WsClipRow.WsClipRow_UniqueNo2, myClm).Value = .txtUniqueNo2.Text
        myWs.Cells(WsClipRow.WsClipRow_Cat, myClm).Value = .cboCat.Text
        myWs.Cells(WsClipRow.WsClipRow_Group, myClm).Value = .cboGroup.Text
        myWs.Cells(WsClipRow.WsClipRow_ProductName, myClm).Value = .cboProductName.Text
        myWs.Cells(WsClipRow.WsClipRow_Usage, myClm).Value = .txtUsage.Text
        myWs.Cells(WsClipRow.WsClipRow_Remarks, myClm).Value = .txtRemarks.Text
        myWs.Cells(WsClipRow.WsClipRow_ManaClass, myClm).Value = .cboManaClass.Text
        myWs.Cells(WsClipRow.WsClipRow_CalCycle, myClm).Value = .txtCalCycle.Text
        myExpDate = .txtExpDateYear.Text & "/" & .txtExpDateMonth.Text & "/1"
        If IsDate(myExpDate) = True Then
            myWs.Cells(WsClipRow.WsClipRow_ExpDate, myClm).Value = FORMAT(myExpDate, "yyyy/m")
        Else
            myWs.Cells(WsClipRow.WsClipRow_ExpDate, myClm).Value = .txtExpDateYear.Text & _
                                                                   .txtExpDateMonth.Text
        End If
        myWs.Cells(WsClipRow.WsClipRow_Maker, myClm).Value = .txtMaker.Text
        myWs.Cells(WsClipRow.WsClipRow_Model, myClm).Value = .txtModel.Text
        myWs.Cells(WsClipRow.WsClipRow_ScaleInterval, myClm).Value = .txtScaleInterVal.Text
        myWs.Cells(WsClipRow.WsClipRow_Meas, myClm).Value = .txtMeas
        myWs.Cells(WsClipRow.WsClipRow_OthersSpec, myClm).Value = .txtOthersSpec.Text
    End With
   
    GoSub Finally
    Exit Sub




'機能   ：有効期限(年月)形式に設定する
'引数   ：settingRng-設定範囲
'戻り値 ：
'**********************************************************
Public Sub SetYYYYMType(ByVal settingRng As Range)

    Const YYYY_M_FORMAT As String = "yyyy.m"   '有効期限
   
    settingRng.NumberFormatLocal = YYYY_M_FORMAT

End Sub

luchanghai

图片中2023.10 还未到有效期限也被筛选出来了。

caffish

应该是时间判断的问题，可能跟格式有关，具体还是需要看附件，一步一步调试下就知道了

luchanghai

caffish 发表于 2023-6-8 09:15
应该是时间判断的问题，可能跟格式有关，具体还是需要看附件，一步一步调试下就知道了

格式各种尝试了，之前格式是有些问题的，现在应该是正确的，我还是发一下附件吧。

luchanghai

上传附件，解压后需要重新链接，DB变更，更新后可以使用。

边缘码农

下载运行后各种提示窗口，也看不懂是啥意思。盲猜一下：

是不是这个地方的问题？

luchanghai

边缘码农 发表于 2023-6-8 11:08
下载运行后各种提示窗口，也看不懂是啥意思。盲猜一下：

是不是这个地方的问题？

运行前要先设置一下的，链接其他表格才能正常运行的
m是月份吧，应该没有问题或者改成什么格式呢/

luchanghai

大神们帮忙解决一下呗

caffish

能定位到问题，但是试了很多方法都无法解决，问题代码在如下的地方：
之所以会拉出来那么多不符合要求的清单，是因为比较的逻辑不对，目前这个程序的算法逻辑是，比如现在的标准时间是2023/6/1，清单比较的时候2023/10/1里月份的第一位是1，比6小，所以就判定符合，可以试一下当把这个日期变成2023/1/1的时候就不会有任何清单了，我一开始怀疑是时间格式被转成了字符串，按位比较所以错误，但是强制转换了以后问题还是依旧，其实即使是第二个条件，选定在几个月以内会过期的清单一样会出现这个问题，你可以试一下当选择3以下时都能拉出来清单，选到5就没有结果了，也是因为2023/11/1的计算又回到了月份第一位的那个逻辑。看别的大神怎么解决吧，SQL这块的语法我不太熟练
类模块clsSearchCond
“ If mExpDate <> "" Then
        If IsDate(mExpDate) = False Then
            mySql = mySql & "AND 有效期限 >=#" & mExpDate & "/1/1" & "# " & _
                            "AND 有效期限 <=#" & mExpDate & "/12/1" & "# "
        Else
            mySql = mySql & "AND 有效期限 =#" & mExpDate & "# "
            
        End If
    End If
    If mExpDateTerm <> "" Then
        Dim baseDate As Date    '基準有効期限
        
        baseDate = GetBaseExpDate
        mySql = mySql & "AND 有效期限 >=#" & baseDate & "# " & _
                        "AND 有效期限 <=#" & DateAdd("m", val(mExpDateTerm), baseDate) & "# "
        
    End If
    If mExpired <> "" Then
        mySql = mySql & "AND 有效期限 < #" & mExpired & "#"”

luchanghai

caffish 发表于 2023-6-9 15:12
能定位到问题，但是试了很多方法都无法解决，问题代码在如下的地方：
之所以会拉出来那么多不符合要求的清 ...

首先谢谢！ 感觉您说的有道理，我也再仔细看看。