求教大神，转置不能正常显示

arnoldlx84

Sub 数组查询()
    Dim i%, n%, m%
    Dim a$, gjz$
    Dim arr, arr1()
    Dim sht As Worksheet, sht1 As Worksheet, sht2 As Worksheet
    Dim wb As Workbook

    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set wb = Workbooks.Open(ThisWorkbook.Path & "\测试.xlsx")
    Set sht = wb.Sheets("ACGIH数据库")
    Set sht1 = ThisWorkbook.Worksheets("ACGIH")
    Set sht2 = ThisWorkbook.Worksheets("输入界面")

    sht1.[a2:l1000].ClearContents
    arr = sht.[a2:l800]
    gjz = "*" & sht2.[I10].Value & "*"


    For i = 1 To UBound(arr)
        a = Join(Array(arr(i, 3)))
        If a Like gjz Then
            m = m + 1
            ReDim Preserve arr1(1 To 12, 1 To m)            
            arr1(1, m) = arr(i, 1)
            arr1(2, m) = arr(i, 2)
            arr1(3, m) = arr(i, 3)
            arr1(4, m) = arr(i, 4)
            arr1(5, m) = arr(i, 5)
            arr1(6, m) = arr(i, 6)
            arr1(7, m) = arr(i, 7)
            arr1(8, m) = arr(i, 8)
            arr1(9, m) = arr(i, 9)
            arr1(10, m) = arr(i, 10)
            arr1(11, m) = arr(i, 11)
            arr1(12, m) = arr(i, 12)
        End If

    Next

    sht1.[a2].Resize(m, 12) = Application.Transpose(arr1)
    rem 如果直接是 sht1.[a2].Resize(m, 12) =arr1 可以显示，只是行列颠倒了。




    wb.Close 0
    Erase arr
    Erase arr1

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

w609053988

试试sht1.[a2].Resize(12,m) = arr1

arnoldlx84

不行，还是那个问题。。。