单元格的公式改用vba怎么表达？

业务员 · 发表于 2023-2-22 21:19

本帖最后由业务员于 2023-2-22 22:40 编辑

=TEXTJOIN("/",TRUE,IF((名单表!$B$2:$B$308943=C2)*(名单表!$A$2:$A$308943=A2),名单表!$C$2:$C$308943,""))

我目前用的公式下拉，=TEXTJOIN("/",TRUE,IF((名单表!$B$2:$B$308943=C3)*(名单表!$A$2:$A$308943=A3),名单表!$C$2:$C$308943,""))
=TEXTJOIN("/",TRUE,IF((名单表!$B$2:$B$308943=C4)*(名单表!$A$2:$A$308943=A4),名单表!$C$2:$C$308943,""))
当单元格下拉到10000个的时候，很卡了。几分钟运行时间，还可能卡死。
我就在想改写数组行不行？名单表!$B$2:$B$308943 名单表!$A$2:$A$308943 构建一个二维数组，计算好结果之后，再把结果赋值给相应单元格。
请老师写几行代码提示一下

附件里面的第一个工作表的E列，公式下拉一万次，还不算很卡。但是f列的=TEXTJOIN("/",TRUE,IF((名单表!$B$2:$B$308943=C2)*(名单表!$A$2:$A$308943=A2),名单表!$C$2:$C$308943,""))下拉一万次就不行了。

洋务德雷 · 发表于 2023-2-22 21:29

上传附件！！！！

HSIAOQIANG · 发表于 2023-2-22 21:35

但是放數組之後好像是沒有TEXTJOIN這個函數的

jinlei2006 · 发表于 2023-2-22 22:05

我也想学习一下，请上传附件

业务员 · 发表于 2023-2-22 22:36

洋务德雷发表于 2023-2-22 21:29
上传附件！！！！

好的，数据太大，已经上传。我们就用小点的数据来模拟吧

zxsea_7426 · 发表于 2023-2-22 22:56

公式越多越卡

业务员 · 发表于 2023-2-22 23:02

HSIAOQIANG 发表于 2023-2-22 21:35
但是放數組之後好像是沒有TEXTJOIN這個函數的

vba直接用&来解决吧。

zxsea_7426 · 发表于 2023-2-22 23:32

mmwwdd · 发表于 2023-2-23 05:32

没看懂什么意思

chxw68 · 发表于 2023-2-23 10:23

Sub test()
Dim r%, i%
Dim arr, brr
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Worksheets("名单表")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("e2:f" & r).ClearContents
arr = .Range("a2:c" & r)
For i = 1 To UBound(arr)
xm = arr(i, 1) & "+" & arr(i, 2)
If Not d.exists(xm) Then
d(xm) = arr(i, 3)
Else
d(xm) = d(xm) & "/" & arr(i, 3)
End If
Next
End With
With Worksheets("运算")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a2:f" & r)
For i = 1 To UBound(arr)
xm = arr(i, 1) & "+" & arr(i, 3)
If d.exists(xm) Then
arr(i, 5) = Split(d(xm), "/")(0)
arr(i, 6) = d(xm)
End If
Next
.Range("a2").Resize(UBound(arr), UBound(arr, 2)) = arr
End With
End Sub

复制代码

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

[求助] 单元格的公式改用vba怎么表达？

评分