使用单个公式填充多维数组的每一列,然后一次性将列复制到多个范围。

huangapple go评论129阅读模式
英文:

Filling every column of a Multidimensional Array with a single formula, than copy column by column to multiple Ranges at once

问题

这个问题与之前的问题相关在此处

我有多个范围,每个范围都是一个列,比如:

"K" & firstRow & ":K" & secondRow```

而我有一个多维数组,我想用单元格公式引用填充这个数组的每一列。因此,结果应该是这样的:

```        J      K       
100  =J103   =K103   
101  =J103   =K103   
102  =J103   =K103   
103  =J103   =K103   
104  =J103   =K103   
105  =J103   =K103   
106  =J103   =K103   

@pᴇʜ提出的解决方案对于单个数组完全有效。

Option Explicit

Public Sub FillFormulaUsingArray()
    Dim Middle As Long
    Middle = 103
    
    Dim firstRow As Long
    firstRow = 100
    
    Dim secondRow As Long
    secondRow = 106
    
    Dim ManagAreaLength As Long
    ManagAreaLength = secondRow - firstRow

    Dim TmpArray() As Variant
    ReDim TmpArray(1 To ManagAreaLength, 1 To 1)
    
    Dim i As Long
    For i = LBound(TmpArray, 1) To UBound(TmpArray, 1)
        TmpArray(i, 1) = "=A" & Middle
    Next i

    Worksheets("Model").Range("B" & firstRow & ":B" & secondRow).Formula = TmpArray()
End Sub

但是我不知道如何使它适用于多个数组和范围。

我想能够像这样做:

Worksheets("Model").Range("J" & firstRow & ":J" & secondRow).formula = TmpArray(1)
Worksheets("Model").Range("K" & firstRow & ":K" & secondRow).formula = TmpArray(2)

另外,为了填充数组,我使用了以下代码:

    Dim item As Variant
    Dim LetterArray As Variant
    LetterArray = Array("J", "K")

        For j = LBound(TmpArray, 2) To UBound(TmpArray, 2)
            For Each item In LetterArray

                For i = LBound(TmpArray, 1) To UBound(TmpArray, 1)
                    TmpArray(i, j) = "=" & item & Middle
                    Debug.Print "i=" & i & ";j=" & j & "==" & TmpArray(i, j)
                Next i
            Next item
        Next j

但似乎它不会产生期望的结果,因为循环在跳转到LetterArray中的另一个项时会覆盖数组。

如何以正确的方式填充数组,如何将每个数组列分配给其相应的范围?另外,如何使这个系统适应超过2个数组和范围?

英文:

This question is related to the previous question here.

I have multiple ranges, every range is a column, say:

"J" & firstRow & ":J" & secondRow
"K" & firstRow & ":K" & secondRow

And I have a multidimensional array, I want to fill each column of this array with a single cell formula reference.
So the outcome should be like:

        J      K       
100  =J103   =K103   
101  =J103   =K103   
102  =J103   =K103   
103  =J103   =K103   
104  =J103   =K103   
105  =J103   =K103   
106  =J103   =K103   

The solution proposed by @pᴇʜ works perfectly for a single array.

Option Explicit

Public Sub FillFormulaUsingArray()
    Dim Middle As Long
    Middle = 103
    
    Dim firstRow As Long
    firstRow = 100
    
    Dim secondRow As Long
    secondRow = 106
    
    Dim ManagAreaLength As Long
    ManagAreaLength = secondRow - firstRow

    Dim TmpArray() As Variant
    ReDim TmpArray(1 To ManagAreaLength, 1 To 1)
    
    Dim i As Long
    For i = LBound(TmpArray, 1) To UBound(TmpArray, 1)
        TmpArray(i, 1) = "=A" & Middle
    Next i

    Worksheets("Model").Range("B" & firstRow & ":B" & secondRow).Formula = TmpArray()
End Sub

But I don't know how to make it work for multiple arrays and ranges.

I'd like to be able to do something like here:

Worksheets("Model").Range("J" & firstRow & ":J" & secondRow).formula = TmpArray(1)
Worksheets("Model").Range("K" & firstRow & ":K" & secondRow).formula = TmpArray(2)

And, to populate arrays with data, I've used the following code:

    Dim item As Variant
    Dim LetterArray As Variant
    LetterArray = Array("J", "K")

        For j = LBound(TmpArray, 2) To UBound(TmpArray, 2)
            For Each item In LetterArray

                For i = LBound(TmpArray, 1) To UBound(TmpArray, 1)
                    TmpArray(i, j) = "=" & item & Middle
                    Debug.Print "i=" & i & ";j=" & j & "==" & TmpArray(i, j)
                Next i
            Next item
        Next j

But it doesn't seem to produce the desired outcome, as the loop overwrites arrays when jumping to another Item in LetterArray.

How do I populate arrays in a correct manner and how do I attribute each array column to it's corresponding range?
Also, how can I make this system adjustable to more than 2 arrays and ranges?

答案1

得分: 2

以下是代码的翻译部分:

Public Sub FillFormulaUsingArray()
    
    Dim sLetters() As Variant: sLetters = Array("A", "C", "E")
    Dim dLetters() As Variant: dLetters = Array("B", "D", "F")
    
    Dim Middle As Long: Middle = 103
    Dim firstRow As Long: firstRow = 100
    Dim secondRow As Long: secondRow = 106
    
    Dim ManagAreaLength As Long: ManagAreaLength = secondRow - firstRow + 1
    Dim TmpArray() As Variant: ReDim TmpArray(1 To ManagAreaLength, 1 To 1)
    
    Dim n As Long, i As Long
    
    For n = LBound(sLetters) To UBound(sLetters)
        For i = LBound(TmpArray, 1) To UBound(TmpArray, 1)
            TmpArray(i, 1) = "=" & sLetters(n) & Middle
        Next i
        Worksheets("Model").Range(dLetters(n) & firstRow & ":" & dLetters(n) & secondRow).Formula = TmpArray
    Next n
        
End Sub
英文:

Copy Formulas

<!-- language: lang-vb -->

Public Sub FillFormulaUsingArray()
    
    Dim sLetters() As Variant: sLetters = Array(&quot;A&quot;, &quot;C&quot;, &quot;E&quot;)
    Dim dLetters() As Variant: dLetters = Array(&quot;B&quot;, &quot;D&quot;, &quot;F&quot;)
    
    Dim Middle As Long: Middle = 103
    Dim firstRow As Long: firstRow = 100
    Dim secondRow As Long: secondRow = 106
    
    Dim ManagAreaLength As Long: ManagAreaLength = secondRow - firstRow + 1
    Dim TmpArray() As Variant: ReDim TmpArray(1 To ManagAreaLength, 1 To 1)
    
    Dim n As Long, i As Long
    
    For n = LBound(sLetters) To UBound(sLetters)
        For i = LBound(TmpArray, 1) To UBound(TmpArray, 1)
            TmpArray(i, 1) = &quot;=&quot; &amp; sLetters(n) &amp; Middle
        Next i
        Worksheets(&quot;Model&quot;).Range(dLetters(n) &amp; firstRow &amp; &quot;:&quot; &amp; dLetters(n) &amp; secondRow).Formula = TmpArray
    Next n
        
End Sub

huangapple
  • 本文由 发表于 2023年3月7日 19:10:11
  • 转载请务必保留本文链接:https://go.coder-hub.com/75661213.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定