【问题标题】:Excel VBA function to print an array to the workbookExcel VBA 函数将数组打印到工作簿
【发布时间】:2011-05-19 19:07:38
【问题描述】:

我编写了一个宏,它采用二维数组,并将其“打印”到 Excel 工作簿中的等效单元格。

有没有更优雅的方法来做到这一点?

Sub PrintArray(Data, SheetName, StartRow, StartCol)

    Dim Row As Integer
    Dim Col As Integer

    Row = StartRow

    For i = LBound(Data, 1) To UBound(Data, 1)
        Col = StartCol
        For j = LBound(Data, 2) To UBound(Data, 2)
            Sheets(SheetName).Cells(Row, Col).Value = Data(i, j)
            Col = Col + 1
        Next j
            Row = Row + 1
    Next i

End Sub


Sub Test()

    Dim MyArray(1 To 3, 1 To 3)
    MyArray(1, 1) = 24
    MyArray(1, 2) = 21
    MyArray(1, 3) = 253674
    MyArray(2, 1) = "3/11/1999"
    MyArray(2, 2) = 6.777777777
    MyArray(2, 3) = "Test"
    MyArray(3, 1) = 1345
    MyArray(3, 2) = 42456
    MyArray(3, 3) = 60

    PrintArray MyArray, "Sheet1", 1, 1

End Sub

【问题讨论】:

    标签: vba excel


    【解决方案1】:

    与其他答案的主题相同,保持简单

    Sub PrintArray(Data As Variant, Cl As Range)
        Cl.Resize(UBound(Data, 1), UBound(Data, 2)) = Data
    End Sub
    
    
    Sub Test()
        Dim MyArray() As Variant
    
        ReDim MyArray(1 To 3, 1 To 3) ' make it flexible
    
        ' Fill array
        '  ...
    
        PrintArray MyArray, ActiveWorkbook.Worksheets("Sheet1").[A1]
    End Sub
    

    【讨论】:

    • 为了 OLE 自动化,分配给Range 实际上意味着分配给它的.Value
    【解决方案2】:

    创建一个变体数组(最简单的方法是将等效范围读入一个变体变量)。

    然后填充数组,将数组直接赋值给范围。

    Dim myArray As Variant
    
    myArray = Range("blahblah")
    
    Range("bingbing") = myArray
    

    变量数组最终会变成一个二维矩阵。

    【讨论】:

      【解决方案3】:

      更优雅的方式是一次分配整个数组:

      Sub PrintArray(Data, SheetName, StartRow, StartCol)
      
          Dim Rng As Range
      
          With Sheets(SheetName)
              Set Rng = .Range(.Cells(StartRow, StartCol), _
                  .Cells(UBound(Data, 1) - LBound(Data, 1) + StartRow, _
                  UBound(Data, 2) - LBound(Data, 2) + StartCol))
          End With
          Rng.Value2 = Data
      
      End Sub
      

      但请注意:它最多只能容纳大约 8,000 个单元格。然后 Excel 抛出一个奇怪的错误。最大大小不是固定的,并且从 Excel 安装到 Excel 安装有很大不同。

      【讨论】:

        【解决方案4】:

        我的测试版本

        Sub PrintArray(RowPrint, ColPrint, ArrayName, WorkSheetName)
        
        Sheets(WorkSheetName).Range(Cells(RowPrint, ColPrint), _
        Cells(RowPrint + UBound(ArrayName, 2) - 1, _
        ColPrint + UBound(ArrayName, 1) - 1)) = _
        WorksheetFunction.Transpose(ArrayName)
        
        End Sub
        

        【讨论】:

          【解决方案5】:

          正如其他人建议的那样,您可以直接将二维数组写入工作表上的 Range,但是如果您的数组是一维的,那么您有两种选择:

          1. 首先将您的一维数组转换为二维数组,然后将其打印在工作表上(作为范围)。
          2. 将一维数组转换为字符串并在单个单元格中打印(作为字符串)。

          这是一个描述这两个选项的示例:

          Sub PrintArrayIn1Cell(myArr As Variant, cell As Range)
              cell = Join(myArr, ",")
          End Sub
          Sub PrintArrayAsRange(myArr As Variant, cell As Range)
              cell.Resize(UBound(myArr, 1), UBound(myArr, 2)) = myArr
          End Sub
          Sub TestPrintArrayIntoSheet()  '2dArrayToSheet
              Dim arr As Variant
              arr = Split("a  b  c", "  ")
          
              'Printing in ONE-CELL: To print all array-elements as a single string separated by comma (a,b,c):
              PrintArrayIn1Cell arr, [A1]
          
              'Printing in SEPARATE-CELLS: To print array-elements in separate cells:
              Dim arr2D As Variant
              arr2D = Application.WorksheetFunction.Transpose(arr) 'convert a 1D array into 2D array
              PrintArrayAsRange arr2D, Range("B1:B3")
          End Sub
          

          注意:Transpose 将逐列渲染输出,以获得逐行输出再次转置它 - 希望有意义。

          HTH

          【讨论】:

            【解决方案6】:

            您可以定义一个范围、数组的大小并使用它的 value 属性:

            Sub PrintArray(Data, SheetName As String, intStartRow As Integer, intStartCol As Integer)
            
                Dim oWorksheet As Worksheet
                Dim rngCopyTo As Range
                Set oWorksheet = ActiveWorkbook.Worksheets(SheetName)
            
                ' size of array
                Dim intEndRow As Integer
                Dim intEndCol As Integer
                intEndRow = UBound(Data, 1)
                intEndCol = UBound(Data, 2)
            
                Set rngCopyTo = oWorksheet.Range(oWorksheet.Cells(intStartRow, intStartCol), oWorksheet.Cells(intEndRow, intEndCol))
                rngCopyTo.Value = Data
            
            End Sub
            

            【讨论】:

              猜你喜欢
              • 1970-01-01
              • 1970-01-01
              • 1970-01-01
              • 1970-01-01
              • 1970-01-01
              • 1970-01-01
              • 1970-01-01
              • 1970-01-01
              • 1970-01-01
              相关资源
              最近更新 更多