VB6总结VI

一.表A为主表，另有表B、C、D，但是B、C、D表中的人是A的子集。现按A遍历每一个人，然后分别拿A中人的UIN去B、C、D中遍历找相同的UIN（For...Next），如果找到了，会进行一些相应的加减法运算（例如B中的日期减去A中的日期，C中的日期减去B中的日期），如果找不到，则在grid中显示空。代码中还有给符合一定条件的格子加颜色。

    intFollowUpListRow = 1
    fgFollowUpList.Rows = 1
    Do While Not rstSQL.EOF
        fgFollowUpList.Rows = fgFollowUpList.Rows + 1
        fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListHiddenFieldCol) = IIf(IsNull(rstSQL("id")), "", rstSQL("id"))
        fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListSNoCol) = intFollowUpListRow
        fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListUINCol) = IIf(IsNull(rstSQL("patient_uin")), "", rstSQL("patient_uin"))
        fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListNameCol) = IIf(IsNull(rstSQL("patient_name")), "", rstSQL("patient_name"))
        fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListRegDateCol) = IIf(IsNull(rstSQL("date_registration")), "", Format(rstSQL("date_registration"), "dd/mm/yyyy"))
        fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListCurrentDefaultCol) = IIf(IsNull(rstSQL("current_default")), "", rstSQL("current_default"))
        fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListDefaultDateCol) = IIf(IsNull(rstSQL("DateDefault")), "", Format(rstSQL("DateDefault"), "dd/mm/yyyy"))
        fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListDaysMissCol) = IIf(IsNull(DateDiff("d", rstSQL("DateDefault"), Date)), "", DateDiff("d", rstSQL("DateDefault"), Date))
        
        sql = 0
        For r = 1 To fgNPHU.Rows - 1
            If fgNPHU.TextMatrix(r, 2) = rstSQL("patient_uin") Then sql = r
        Next r
        If sql = 0 Then
            fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListDaysReferNPHUCol) = ""
        Else
            fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListDaysReferNPHUCol) = DateDiff("d", rstSQL("DateDefault"), fgNPHU.TextMatrix(intFollowUpListRow, 11))
            fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListReferNPHUDateCol) = fgNPHU.TextMatrix(intFollowUpListRow, 11)
        End If
        
        sql = 0
        For r = 1 To fgFirst.Rows - 1
            If fgFirst.TextMatrix(r, 2) = rstSQL("patient_uin") Then sql = r
        Next r
        If sql <> 0 Then
            fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListDaysFirstReplyCol) = DateDiff("d", fgNPHU.TextMatrix(intFollowUpListRow, 11), fgFirst.TextMatrix(intFollowUpListRow, 12))
            fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListFirstReplyDateCol) = fgFirst.TextMatrix(intFollowUpListRow, 12)
        Else
            strCal = DateDiff("d", fgNPHU.TextMatrix(intFollowUpListRow, 11), Date)
            fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListDaysFirstReplyCol) = "no reply yet (" & strCal & ")"
            If strCal > 14 Then
                With fgFollowUpList
                    .Row = intFollowUpListRow
                    .Col = fFollowUpListDaysFirstReplyCol
    '                    .CellBackColor = &HEAD5FF
                    .CellBackColor = &HFF80FF   '粉红色
                End With
            End If
        End If
        
        sql = 0
        For r = 1 To fgLast.Rows - 1
            If fgLast.TextMatrix(r, 2) = rstSQL("patient_uin") Then sql = r
        Next r
        If sql <> 0 Then
            fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListDaysLastReplyCol) = DateDiff("d", fgLast.TextMatrix(intFollowUpListRow, 13), Date)
            fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListLastReplyDateCol) = fgLast.TextMatrix(intFollowUpListRow, 13)
            If fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListDaysLastReplyCol) > 14 Then
                With fgFollowUpList
                    .Row = intFollowUpListRow
                    .Col = fFollowUpListDaysLastReplyCol
    '                    .CellBackColor = &HEAD5FF
                    .CellBackColor = &HFF80FF   '粉红色
                End With
            End If
        Else
            fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListDaysLastReplyCol) = " "
        End If
             
        If fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListDaysMissCol) > 14 And fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListDaysMissCol) <= 40 Then
            With fgFollowUpList
                .Row = intFollowUpListRow
                .Col = fFollowUpListDaysMissCol
                .CellBackColor = &HFF80FF   '粉红色
            End With
        ElseIf fgFollowUpList.TextMatrix(intFollowUpListRow, fFollowUpListDaysMissCol) > 40 Then
            With fgFollowUpList
                .Row = intFollowUpListRow
                .Col = fFollowUpListDaysMissCol
                .CellBackColor = &HFF&   '红色
            End With
        End If
        rstSQL.MoveNext
        intFollowUpListRow = intFollowUpListRow + 1
    Loop

二.VB6中的几个判断语句

1.rstSQL为空

If (rstSQL.EOF And rstSQL.BOF) Then

2.rstSQL不为空

If Not (rstTBCUDefaulter.EOF And rstTBCUDefaulter.BOF) Then

3.rstSQL中的name列不为空

If Not IsNull(rstTBCUDefaulter("date_birth")) Then