VBA ADO查询单条记录时Transpose转置致列表框显示异常

ADODB.Recordset的GetRows方法返回的数组结构为**(字段列索引, 记录行索引)，而VBA中ListBox控件的.List属性要求输入的数组结构为(记录行索引, 字段列索引)**，因此多条记录时使用Application.Transpose做行列转置可以正常适配。
单条记录返回时显示异常的核心原因是：Application.Transpose方法存在固有特性，当被转置的数组某一维度长度为1时，会自动将二维数组降维为一维数组，输出结构不符合ListBox的二维数组要求；之前尝试的「单条记录不执行转置」逻辑无效，是因为不转置的数组维度顺序是(列数,1)，和ListBox要求的(行数,列数)顺序完全相反，自然无法正常显示。

在给ListBox赋值前，先判断返回的记录条数，针对单条记录场景手动构造符合要求的数组，避开Transpose的降维问题即可，替换原有给lstResults赋值的代码段即可生效。
修改后的对应代码段如下：

' 原有数据库连接、SQL执行、GetRows获取数据的逻辑保持不变
With EmployeeOutput
    .ActiveConnection = calldbconn
    .Source = SQLString
    .LockType = adLockOptimistic
    .CursorType = adOpenKeyset
    .Open
    EmpData = .GetRows
    On Error GoTo CloseRecordset
End With

' 替换原有Listbox赋值逻辑
Dim rowCount As Long, colCount As Long
Dim outputArr As Variant
Dim i As Long, j As Long

With lstResults
    .Clear
    ' 先判断是否存在有效返回记录
    If IsArray(EmpData) Then
        colCount = UBound(EmpData, 1) - LBound(EmpData, 1) + 1
        rowCount = UBound(EmpData, 2) - LBound(EmpData, 2) + 1
        
        If rowCount = 1 Then
            ' 单条记录场景：手动构造适配的二维数组，不使用Transpose避免降维
            ReDim outputArr(0 To 0, 0 To colCount - 1)
            For j = 0 To colCount - 1
                outputArr(0, j) = EmpData(j, 0)
            Next j
            .List = outputArr
        Else
            ' 多条记录场景：正常转置即可适配
            .List = Application.Transpose(EmpData)
        End If
    End If
End With

补充说明：上述逻辑同时兼容0条记录返回的场景，无匹配结果时列表会保持清空状态，不会抛出运行错误。

内容的提问来源于stack exchange，提问作者Ace_Q