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

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

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

问题

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

我有多个范围，每个范围都是一个列，比如：

  1. "K" & firstRow & ":K" & secondRow```
  3. 而我有一个多维数组，我想用单元格公式引用填充这个数组的每一列。因此，结果应该是这样的：
  5. ```        J      K       
  6. 100  =J103   =K103   
  7. 101  =J103   =K103   
  8. 102  =J103   =K103   
  9. 103  =J103   =K103   
  10. 104  =J103   =K103   
  11. 105  =J103   =K103   
  12. 106  =J103   =K103

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

  1. Option Explicit
  3. Public Sub FillFormulaUsingArray()
  4.     Dim Middle As Long
  5.     Middle = 103
  6.     
  7.     Dim firstRow As Long
  8.     firstRow = 100
  9.     
  10.     Dim secondRow As Long
  11.     secondRow = 106
  12.     
  13.     Dim ManagAreaLength As Long
  14.     ManagAreaLength = secondRow - firstRow
  16.     Dim TmpArray() As Variant
  17.     ReDim TmpArray(1 To ManagAreaLength, 1 To 1)
  18.     
  19.     Dim i As Long
  20.     For i = LBound(TmpArray, 1) To UBound(TmpArray, 1)
  21.         TmpArray(i, 1) = "=A" & Middle
  22.     Next i
  24.     Worksheets("Model").Range("B" & firstRow & ":B" & secondRow).Formula = TmpArray()
  25. End Sub

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

我想能够像这样做：

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

另外，为了填充数组，我使用了以下代码：

  1.     Dim item As Variant
  2.     Dim LetterArray As Variant
  3.     LetterArray = Array("J", "K")
  5.         For j = LBound(TmpArray, 2) To UBound(TmpArray, 2)
  6.             For Each item In LetterArray
  8.                 For i = LBound(TmpArray, 1) To UBound(TmpArray, 1)
  9.                     TmpArray(i, j) = "=" & item & Middle
  10.                     Debug.Print "i=" & i & ";j=" & j & "==" & TmpArray(i, j)
  11.                 Next i
  12.             Next item
  13.         Next j

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

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

英文:

This question is related to the previous question here.

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

  1. "J" & firstRow & ":J" & secondRow
  2. "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:

  1.         J      K       
  2. 100  =J103   =K103   
  3. 101  =J103   =K103   
  4. 102  =J103   =K103   
  5. 103  =J103   =K103   
  6. 104  =J103   =K103   
  7. 105  =J103   =K103   
  8. 106  =J103   =K103

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

  1. Option Explicit
  3. Public Sub FillFormulaUsingArray()
  4.     Dim Middle As Long
  5.     Middle = 103
  6.     
  7.     Dim firstRow As Long
  8.     firstRow = 100
  9.     
  10.     Dim secondRow As Long
  11.     secondRow = 106
  12.     
  13.     Dim ManagAreaLength As Long
  14.     ManagAreaLength = secondRow - firstRow
  16.     Dim TmpArray() As Variant
  17.     ReDim TmpArray(1 To ManagAreaLength, 1 To 1)
  18.     
  19.     Dim i As Long
  20.     For i = LBound(TmpArray, 1) To UBound(TmpArray, 1)
  21.         TmpArray(i, 1) = "=A" & Middle
  22.     Next i
  24.     Worksheets("Model").Range("B" & firstRow & ":B" & secondRow).Formula = TmpArray()
  25. 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:

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

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

  1.     Dim item As Variant
  2.     Dim LetterArray As Variant
  3.     LetterArray = Array("J", "K")
  5.         For j = LBound(TmpArray, 2) To UBound(TmpArray, 2)
  6.             For Each item In LetterArray
  8.                 For i = LBound(TmpArray, 1) To UBound(TmpArray, 1)
  9.                     TmpArray(i, j) = "=" & item & Middle
  10.                     Debug.Print "i=" & i & ";j=" & j & "==" & TmpArray(i, j)
  11.                 Next i
  12.             Next item
  13.         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

以下是代码的翻译部分：

  1. Public Sub FillFormulaUsingArray()
  2.     
  3.     Dim sLetters() As Variant: sLetters = Array("A", "C", "E")
  4.     Dim dLetters() As Variant: dLetters = Array("B", "D", "F")
  5.     
  6.     Dim Middle As Long: Middle = 103
  7.     Dim firstRow As Long: firstRow = 100
  8.     Dim secondRow As Long: secondRow = 106
  9.     
  10.     Dim ManagAreaLength As Long: ManagAreaLength = secondRow - firstRow + 1
  11.     Dim TmpArray() As Variant: ReDim TmpArray(1 To ManagAreaLength, 1 To 1)
  12.     
  13.     Dim n As Long, i As Long
  14.     
  15.     For n = LBound(sLetters) To UBound(sLetters)
  16.         For i = LBound(TmpArray, 1) To UBound(TmpArray, 1)
  17.             TmpArray(i, 1) = "=" & sLetters(n) & Middle
  18.         Next i
  19.         Worksheets("Model").Range(dLetters(n) & firstRow & ":" & dLetters(n) & secondRow).Formula = TmpArray
  20.     Next n
  21.         
  22. End Sub
英文:

Copy Formulas

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

  1. Public Sub FillFormulaUsingArray()
  2.     
  3.     Dim sLetters() As Variant: sLetters = Array(&quot;A&quot;, &quot;C&quot;, &quot;E&quot;)
  4.     Dim dLetters() As Variant: dLetters = Array(&quot;B&quot;, &quot;D&quot;, &quot;F&quot;)
  5.     
  6.     Dim Middle As Long: Middle = 103
  7.     Dim firstRow As Long: firstRow = 100
  8.     Dim secondRow As Long: secondRow = 106
  9.     
  10.     Dim ManagAreaLength As Long: ManagAreaLength = secondRow - firstRow + 1
  11.     Dim TmpArray() As Variant: ReDim TmpArray(1 To ManagAreaLength, 1 To 1)
  12.     
  13.     Dim n As Long, i As Long
  14.     
  15.     For n = LBound(sLetters) To UBound(sLetters)
  16.         For i = LBound(TmpArray, 1) To UBound(TmpArray, 1)
  17.             TmpArray(i, 1) = &quot;=&quot; &amp; sLetters(n) &amp; Middle
  18.         Next i
  19.         Worksheets(&quot;Model&quot;).Range(dLetters(n) &amp; firstRow &amp; &quot;:&quot; &amp; dLetters(n) &amp; secondRow).Formula = TmpArray
  20.     Next n
  21.         
  22. End Sub

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

发表评论

匿名网友

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

确定