首页 > 解决方案 > Excel VBA - 将数组写入工作表

问题描述

我正在尝试编写一个代码(见下文),该代码从所选范围中获取公式并将它们粘贴到用户定义的另一个范围中而不更改参考。

我无法将数组中的项目写入工作表。它只是粘贴第一项......我已经阅读了一些帖子并应用了各种代码,但这些都不起作用......你能给一些建议如何解决这个问题吗?提前致谢。

Sub copy_formulas()

Dim formula As String
Dim rg As Range, rg_row As Integer, rg_column As Integer
Dim cl As Range
Dim col As New Collection, i As Integer
Dim arr As Variant
Dim output As Range

Set rg = Selection
    rg_row = rg.Rows.Count
    rg_column = rg.Columns.Count

For Each cl In rg
    If cl.Value = "" Then
        formula = ""
    Else
        formula = cl.FormulaLocal
    End If
    col.Add formula
Next

ReDim arr(1 To col.Count)
For i = 1 To col.Count
    arr(i) = col.Item(i)
Next i

Set output = Application.InputBox("Select Range", "Range for pasting formulas", Type:=8)
output.Resize(rg_row, rg_column).Select
output.FormulaLocal = arr

End Sub

编辑
对于任何有兴趣的人,这就是我最终想出的:

Sub copy_formulas()

Dim formula As String
Dim rg As Range, rg_row As Integer, rg_column As Integer
Dim cl As Range
Dim col As New Collection, i As Integer, y As Integer
Dim arr() As Variant
Dim output As Range

Set rg = Selection
    rg_row = rg.Rows.Count
    rg_column = rg.Columns.Count

For Each cl In rg
    If cl.Value = "" Then
        formula = ""
    Else
        formula = cl.FormulaLocal
    End If
    col.Add formula
Next

ReDim arr(1 To rg_row, 1 To rg_column)
For i = 1 To rg_row
    For y = 1 To rg_column
        arr(i, y) = col.Item(((i - 1) * rg_column) + y)
    Next y
Next i

Set output = Application.InputBox("Select Range", "Range for pasting formulas", Type:=8)
output.Resize(rg_row, rg_column).FormulaLocal = arr
End Sub

我将不胜感激有关此主题的任何反馈。

标签: excelvba

解决方案


好的,因此可以以更简单的方式解决此任务(如下)。虽然,我会对如何使用第一个问题中提到的代码来完成它感兴趣......

Sub copy_formulas_2()
Dim y As Variant
Dim rg_row As Integer, rg_column As Integer
Dim i As Long

With Selection
    y = .FormulaLocal
    rg_row = .Rows.Count
    rg_column = .Columns.Count
End With

Set output = Application.InputBox("Select Range", "Range for pasting formulas", Type:=8)
output.Resize(rg_row, rg_column).FormulaLocal = y

End Sub

推荐阅读