当值绑定到 Excel 或 Access 中的 vbNewLine 时，如何比较 VBA 中的两个值

Question

这是关于日历的结构，因为我已经内置了太多的功能，我不能用 vbNewLine 改变块，所以我需要找到解决这一点问题的方法：

一个函数应该比较两个值并在匹配的情况下触发一个动作。

值 myArray(i, 2) 是天数：

Private Sub InitVariables()

intMonth = Me.cboMonth
intYear = Me.cboYear
lngFirstDayOfMonth = CLng(DateSerial(intYear, intMonth, 1))
intFirstWeekday = getFirstWeekday(lngFirstDayOfMonth)
intDaysInMonth = getDaysInMonth(intMonth, intYear)

End Sub

Private Sub InitArray()
Dim i As Integer

ReDim myArray(0 To 41, 0 To 2)

For i = 0 To 41

    myArray(i, 0) = lngFirstDayOfMonth - intFirstWeekday + 1 + i
    If Month(myArray(i, 0)) = intMonth Then
        myArray(i, 1) = True
        myArray(i, 2) = Day(myArray(i, 0))
    Else
        myArray(i, 1) = False
    
    End If
Next i

End Sub

Private Sub LoadArray()

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsFiltered As DAO.Recordset
Dim strsql As String
Dim i As Integer
Dim OrgTime As Date
Dim MyStrTime As String

On Error Resume Next

strsql = "SELECT * from qrytblImVst;"

Set db = CurrentDb
Set rs = db.OpenRecordset(strsql)

    If Not rs.BOF And Not rs.EOF Then

        For i = LBound(myArray) To UBound(myArray)

            If myArray(i, 1) Then
                rs.Filter = "[vDate]=" & myArray(i, 0)

                Set rsFiltered = rs.OpenRecordset

                Do While (Not rsFiltered.EOF)
                
                    OrgTime = rsFiltered!vZeit
                    MyStrTime = Format(OrgTime, "hh:mm")
                    
                    myArray(i, 2) = myArray(i, 2) & vbNewLine _
                    & "<div><font color=red> " + MyStrTime + "  </div>"

                    End If
                    
                    rsFiltered.MoveNext
                Loop

            End If
        Next i

    End If

    rsFiltered.Close
    rs.Close

Set rsFiltered = Nothing
Set rs = Nothing
Set db = Nothing

End Sub

Private Sub PrintArray()

'On Error Resume Next

Dim strCtlName As Variant
Dim strCtlName1 As Variant
Dim i As Integer
Dim lngBlack As Long
Dim lngWhite As Long

lngBlack = RGB(36, 39, 50)
lngWhite = RGB(166, 166, 166)

For i = LBound(myArray) To UBound(myArray)
    
    strCtlName = "TXT" & CStr(i + 1)
    Controls(strCtlName).Tag = i
    Controls(strCtlName) = ""
    Controls(strCtlName) = myArray(i, 2)

If IsNull(Controls(strCtlName)) Then
Controls(strCtlName).Visible = False
Else
Controls(strCtlName).Visible = True
End If

If CStr(Me.cboMonth) = CStr(Month(Date)) And CStr(Me.cboYear) = CStr(Year(Date)) And Len(myArray(i, 2)) <> 0 Then
    If Split(myArray(i, 2), vbNewLine)(0) = CStr(Day(Date)) Then
         Controls(strCtlName).BorderColor = lngRed
         Controls(strCtlName).BorderWidth = 2
    End If
Else
Controls(strCtlName).BorderColor = lngWhite
Controls(strCtlName).BorderWidth = 1
End If

    strCtlName = "CAL" & CStr(i + 1)
    Controls(strCtlName).Tag = i
    Controls(strCtlName) = ""
    If InStr(myArray(i, 2), "div") Then
    Controls(strCtlName) = Left(myArray(i, 2), 2)
    Else
    Controls(strCtlName) = myArray(i, 2)
    End If

If IsNull(Controls(strCtlName)) Then
Controls(strCtlName).Visible = False
Else
Controls(strCtlName).Visible = True
End If

Next i

End Sub

比较结果如下：

If Left(myArray(i, 2), 2) = CStr(Day(Date)) Then
     Controls(strCtlName).BorderColor = lngRed
     Controls(strCtlName).BorderWidth = 2
End If

我总是得到一个 FALSE 作为结果，因为 vbNewLine 以不匹配的方式更改日期数值。

为了检查导致问题的原因，我添加了“//”，看起来像这样

msgbox Left(myArray(i, 2), 2) & "//"

结果是：

5
 //

对于所有日历日，我该如何解决这个问题？谢谢！

Answer 1

您的比较是查看存储值的前两个字符。当天数小于10时，第二个字符将是vbNewLine，因为天数只有一位。

您可以使用 Split 来捕获 vbNewLine 左侧的所有字符，而不是使用 Left 来捕获固定数量的字符。

If Split(myArray(i, 2), vbNewLine)(0) = CStr(Day(Date)) Then
     Controls(strCtlName).BorderColor = lngRed
     Controls(strCtlName).BorderWidth = 2
End If

当 myArray(i,2) 没有值时，

Split 将 return 错误 (9)。您需要对这种情况进行检查：

If Len(myArray(i,2)) <> 0 Then
    If Split(myArray(i, 2), vbNewLine)(0) = CStr(Day(Date)) Then
         Controls(strCtlName).BorderColor = lngRed
         Controls(strCtlName).BorderWidth = 2
    End If
End If

当值绑定到 Excel 或 Access 中的 vbNewLine 时，如何比较 VBA 中的两个值

How to compare two values in VBA when a value is bound to vbNewLine in Excel or Access

excel

ms-access

vba

compare