这似乎是利用GetRows()
ADO RecordSet 方法的好时机。 GetRows()
将记录集转换为多维数组,然后通过该数组来比较值是相当简单的——在这种情况下,这是一个重要的特性。
以下代码适用于我的测试数据:
' Assuming the connection and recordset have already been created previous to this point
Response.Write "<table border='1' width='100%' cellpadding='5' cellspacing='0'>"
' Uncomment below when using the recordset
' Response.Write GetHeaderHtml(qdata)
Response.Write "<tbody>"
' Uncomment below when using the recordset
' Dim rsArray : rsArray = qdata.GetRows
' qdata.Close
' oConnection.Close
' Set qdata = Nothing
' Set oConnection = Nothing
' FOR TESTING ONLY:
Dim rsArray(2, 9)
rsArray(0, 0) = "X1"
rsArray(0, 1) = "X1"
rsArray(0, 2) = "X1"
rsArray(0, 3) = "X1"
rsArray(0, 4) = "X1"
rsArray(0, 5) = "X2"
rsArray(0, 6) = "X2"
rsArray(0, 7) = "X2"
rsArray(0, 8) = "X2"
rsArray(0, 9) = "X2"
rsArray(1, 0) = "A"
rsArray(1, 1) = "A"
rsArray(1, 2) = "A"
rsArray(1, 3) = "B"
rsArray(1, 4) = "B"
rsArray(1, 5) = "A"
rsArray(1, 6) = "A"
rsArray(1, 7) = "B"
rsArray(1, 8) = "C"
rsArray(1, 9) = "C"
rsArray(2, 0) = "12"
rsArray(2, 1) = "332"
rsArray(2, 2) = "32"
rsArray(2, 3) = "14"
rsArray(2, 4) = "10"
rsArray(2, 5) = "155"
rsArray(2, 6) = "23"
rsArray(2, 7) = "25"
rsArray(2, 8) = "32"
rsArray(2, 9) = "38"
' END TESTING DATA
Dim rowHtml, occurances, row, col
For row = LBound(rsArray, 2) To UBound(rsArray, 2) ' the second dimension is row
rowHtml = "<tr>"
For col = LBound(rsArray, 1) To UBound(rsArray, 1) ' the first dimension is column
If row > LBound(rsArray, 2) Then
' previous rows written, only write out the cell if it is different than the one above.
If rsArray(col, row) <> rsArray(col, row - 1) Then
occurances = CountColumnOccurances(col, row, rsArray)
' you could probably get away writing "rowspan='1'", but I'll test for it and omit if 1
If occurances > 1 Then
rowHtml = rowHtml & "<td rowspan='" & CountColumnOccurances(col, row, rsArray) & "'>"
Else
rowHtml = rowHtml & "<td>"
End If
rowHtml = rowHtml & Server.HTMLEncode(rsArray(col, row))
rowHtml = rowHtml & "</td>"
End If
Else
occurances = CountColumnOccurances(col, row, rsArray)
' you could probably get away writing "rowspan='1'", but I'll test for it and omit if 1
If occurances > 1 Then
rowHtml = rowHtml & "<td rowspan='" & CountColumnOccurances(col, row, rsArray) & "'>"
Else
rowHtml = rowHtml & "<td>"
End If
rowHtml = rowHtml & Server.HTMLEncode(rsArray(col, row))
rowHtml = rowHtml & "</td>"
End If
Next ' col
rowHtml = rowHtml & "</tr>" & vbCrlf
Response.Write rowHtml
Next ' row
Response.Write "</tbody>"
Response.Write "</table>"
Function CountColumnOccurances(curCol, curRow, arr)
Dim occurances : occurances = 1 ' how many repeats
Dim examinedRow : examinedRow = curRow + 1 ' the row we're comparing to
Dim curValue : curValue = arr(curCol, curRow) ' the value were using to compare
Do While examinedRow <= UBound(arr, 2) ' the second dimension is row
If arr(curCol, examinedRow) = curValue Then ' the next row has the same value
occurances = occurances + 1
Else ' the next row is different
Exit Do
End If
examinedRow = examinedRow + 1
Loop
CountColumnOccurances = occurances
End Function
Function GetHeaderHtml(rsData)
Dim strHeaders : strHeaders = "<thead><tr>"
Dim objField
For Each objField In rsData.Fields
strHeaders = strHeaders & "<th align='center' valign='middle' bgcolor='#CCCCCC'><strong>" & objField.Name & "</strong></th>"
Next
strHeaders = strHeaders & "</tr></thead>"
GetHeaderHtml = strHeaders
End Function