- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2024-12-18
|
5#
發表於 2021-8-20 07:45
| 只看該作者
回復 3# edmondsforum
請測試看看，謝謝
Sub test()
Dim Arr, Brr(), xD, i&, n%
Set xD = CreateObject("Scripting.Dictionary")
With Sheets("A")
Arr = .Range(.[ag1], .[c66635].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 3)
For i = 7 To UBound(Arr)
n = n + 1: Brr(n, 1) = Arr(5, 2)
Brr(n, 2) = Arr(i, 7)
If Arr(i, 23) <> "" Then
Brr(n, 3) = Arr(i, 23)
Else
Brr(n, 3) = Arr(i, 31)
End If
Next
End With
With Sheets("B")
R = .Range("r65536").End(3).Row + 1
.Range("r" & R) = Arr(5, 2)
.Range("s" & R) = Arr(2, 24)
R = .Range("d65536").End(3).Row + 1
.Range("d" & R).Resize(n, 3) = Brr
Arr = .Range(.[g1], .[d66635].End(3))
For i = R To UBound(Arr)
.Cells(i, 7) = Arr(i, 3) + .Cells(i - 1, 7)
Next
End With
End Sub |
|
