数组法写入内容

天地一相 · 发表于 2023-6-28 10:37

本帖最后由天地一相于 2023-6-29 10:21 编辑

感谢帮助！详见截图附件。

陆离Lowry · 发表于 2023-6-28 10:41

没看明白，为什么要一次一列，一次写入不行吗？

liujing_hotwind · 发表于 2023-6-28 11:29

天地一相 · 发表于 2023-6-28 11:42

陆离Lowry 发表于 2023-6-28 10:41
没看明白，为什么要一次一列，一次写入不行吗？

谢谢，不行，就是执行1次，写入1列，覆盖写入。其实我原本用COPY提取的，一列一列按顺序提取到C列的。自己尝试用数组，搞不定行范围怎么处理。

liujing_hotwind · 发表于 2023-6-28 11:59

天地一相发表于 2023-6-28 11:42
谢谢，不行，就是执行1次，写入1列，覆盖写入。其实我原本用COPY提取的，一列一列按顺序提取到C列的。自 ...

你是要覆盖啊，那要改一下

笨鸟飞不高 · 发表于 2023-6-28 12:04

数组返回.zip (51.17 KB, 下载次数: 5)

猜一个！

天地一相 · 发表于 2023-6-28 12:45

笨鸟飞不高发表于 2023-6-28 12:04
猜一个！

谢谢，基本猜对，轻微修改，测试对比，没速度上的提升，见代码，估计是计算语句的下一半耗时了。可否也用数组法修改下？因为我想，下一半代码是汇总内容的，若先保存在数组中，最后一次性写入，应该能提速。表2区域，A2：AG7。表1区域A2:AH,(第2行开始往下写)

arr = Sheet4.[A1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 1)
For c = 1 To UBound(arr, 2) - 2
For i = 1 To UBound(arr)
brr(i, 1) = arr(i, c)
Next
Sheet3.Range("C1").Resize(UBound(brr)) = brr
For d = c + 1 To UBound(arr, 2) - 1
For i = 1 To UBound(arr)
brr(i, 1) = arr(i, d)
Next
Sheet3.Range("D1").Resize(UBound(brr)) = brr
For e = d + 1 To UBound(arr, 2)
For i = 1 To UBound(arr)
brr(i, 1) = arr(i, e)
Next
Sheet3.Range("E1").Resize(UBound(brr)) = brr
Calculate
If Application.WorksheetFunction.CountBlank(Sheet2.Range("B2:B7")) < 6 Then
For k = 2 To 7
If Application.WorksheetFunction.CountBlank(Sheet2.Cells(k, "B")) < 1 Then
n = n + 1
Sheet1.Cells(n, 1).Value = Sheet3.Range("C1").Value & "-" & Sheet3.Range("D1").Value & "-" & Sheet3.Range("E1").Value
Sheet1.Range(Sheet1.Cells(n, "B"), Sheet1.Cells(n, "AH")).Value = Sheet2.Range(Sheet2.Cells(k, "A"), Sheet2.Cells(k, "AG")).Value
End If
Next k
End If
Next e, d, c

复制代码

sdytsxd991122 · 发表于 2023-6-28 13:11

是这个意思？

ykcbf1100 · 发表于 2023-6-28 13:23

应该没达到你的要求，但循环复制是可以了。
你参考一下吧。。。

天地一相 · 发表于 2023-6-28 14:21

sdytsxd991122 发表于 2023-6-28 13:11
是这个意思？

谢谢，很受启发

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

[已解决] 数组法写入内容