简体   繁体   English

Excel VBA-将数组写入工作表

[英]Excel VBA - Writing array to the Worksheet

I'm trying to write a code (see below) which takes formulas from the selected range and pastes them in another range defined by the user without changing the reference. 我正在尝试编写一个代码(请参见下文),该代码将从选定范围内提取公式并将其粘贴到用户定义的另一个范围内,而无需更改引用。

I'm having trouble with writing the items from the array to the worksheet. 我在将项目从数组写入工作表时遇到麻烦。 It just pastes the first item... I've read some posts and applied various codes but none of these worked... Can you give some advice how to fix that? 它只是粘贴了第一项...我已经阅读了一些帖子,并应用了各种代码,但这些都不起作用...您能提供一些建议来解决此问题吗? Thanks in advance. 提前致谢。

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

EDIT : 编辑
For anyone who is interested, this is what I finally came up with: 对于任何有兴趣的人,这就是我最终想出的:

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

I would appreciate any feedback on this topic. 对于这个主题的任何反馈,我将不胜感激。

OK, so this task can be solved in an easier way (below). 好的,因此可以通过以下更简单的方式解决此任务。 Although, I would be interrested how it can be done using the code mentioned in the first question... 虽然,我会很困惑如何使用第一个问题中提到的代码来完成...

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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM