將函數公式寫入數組再輸出值

lrq20501 · 发表于 2024-3-14 11:37

求教大神们~~~

###资料说明###
1. J2:M2为公式下拉填满的资料
2. 通常会下拉填满公式函数后，再将J3:M&lastRow复制贴上值，避免执行效率问题

###问题点###
若是资料行或列太多，则执行上会发常慢，比如说有100万笔资料时，使用autofill下拉填满公式 +再将J3:M&lastRow复制贴上值，执行就会很久。

###需求###
是否能使用数组的方式来执行类似的作业以提高执行效率

下列是试着找的资料来执行，但发现公式并没有「下拉填满」而是同一行的公式都变成与J2:M2相同…
有哪位比较了解数组的大神能救救此问题，谢谢哈

Sub Test()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim formulasArray As Variant
formulasArray = ws.Range("J2:M2").Formula
Dim outputArray() As Variant
ReDim outputArray(1 To lastRow - 1, 1 To UBound(formulasArray, 2))
Dim i As Long, j As Long
For i = 1 To UBound(outputArray, 1)
For j = 1 To UBound(outputArray, 2)
outputArray(i, j) = formulasArray(1, j)
Next j
Next i
ws.Range("J2:M" & lastRow) = outputArray
End Sub

复制代码

大灰狼1976 · 发表于 2024-3-14 11:42

不便下载附件确认，是不是下面这句写错了
outputArray(i, j) = formulasArray(1, j)

山菊花 · 发表于 2024-3-14 11:51

供参考。

lrq20501 · 发表于 2024-3-14 13:39

大灰狼1976 发表于 2024-3-14 11:42
不便下载附件确认，是不是下面这句写错了
outputArray(i, j) = formulasArray(1, j)

应该也不是，公式函数的逻辑是要依2列的没错；但行数要依实际行数做变动

lrq20501 · 发表于 2024-3-14 13:40

山菊花发表于 2024-3-14 11:51
供参考。

谢谢，结果是正确的
但主要就是不想要直接在宏中写函数公式，希望能以autofill的逻辑来做数组

大灰狼1976 · 发表于 2024-3-14 13:51

Sub Test()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim formulasArray As Variant
formulasArray = ws.Range("J2:M2").Formula
ws.Range("J2:M" & lastRow) = formulasArray
End Sub

复制代码

rudy_0990 · 发表于 2024-3-14 14:34

数组也要吃内存，你这么想，把公式按条件填进去
把公司当做常量和变量的组合，给单元格赋值，
架构就是代码+函数公式的组合
比如AB两列乘积在C列
sub 乘积（）
****
****
range（“C” & i ）=“=(A” & i & " *B" & i & ")"

***
end sub

		自动登录	找回密码
密码			免费注册

[求助] 將函數公式寫入數組再輸出值

评分