麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 函數陣列資料如何以以VBA執行 [打印本頁]

作者: keny1021 時間: 2022-8-4 10:44 標題: 函數陣列資料如何以以VBA執行

各位老師好:

附件EXCEL以陣列方式帶入資料，資料日漸龐大，處理起來延遲及耗時。
可以協助以VBA的程式執行實現嗎?謝謝

作者: samwang 時間: 2022-8-4 12:25

回復 1# keny1021

請測試看看，謝謝

Sub test()
Dim Arr, Brr(), T$, i&, j%
T = Sheets(2).Range("e4")
Arr = Sheets(1).Range("a1").CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To 11)
For i = 2 To UBound(Arr)
If Arr(i, 1) = T Then
      n = n + 1: For j = 2 To 7: Brr(n, j - 1) = Arr(i, j): Next
      For j = 8 To 11
      Brr(n, j) = Application.RandBetween(Brr(n, 6) * 100, Brr(n, 5) * 100) * 0.01
      Next
End If
Next
If n > 0 Then
With Sheets(2)
      .[b6].CurrentRegion.Offset(1) = ""
      .[b7].Resize(n, 11) = Brr
End With
End If
End Sub

作者: keny1021 時間: 2022-8-4 16:12

回復 2# samwang

Samwang 大大感謝您:

可以再麻煩您，當我格式稍作調整後，發現A5:L5儲存格若有建立值後，執行後，整個B6:L6的值會被清除掉。
麻煩再看一下怎樣做調整.謝謝

作者: samwang 時間: 2022-8-5 07:21

回復 samwang

Samwang 大大感謝您:

可以再麻煩您，當我格式稍作調整後，發現A55儲存格若有建立值 ...
keny1021 發表於 2022-8-4 16:12

因為你原來的不連續，所以從第6列往下1列後清除.[b6].CurrentRegion.Offset(1) = ""
現在是連續資料所以改為從第1列往下6以後清除
.[b1].CurrentRegion.Offset(6) = ""

作者: keny1021 時間: 2022-8-5 10:57

回復 4# samwang

Samwang 大大您好:測試結果OK。感謝指點

下列語法是之前套用在函數的陣列跑批次迴圈執行資料生成後列印(PDF虛擬印表機)，
如何結合您提供的VBA進行資料迴圈列印，如附件"Isp-test-3 預期結果"

Private Sub CommandButton1_Click()
Set sh3 = Worksheets("List")
Set sh2 = Worksheets("Isp")
For AA = 1 To Application.CountA(sh3.Range("a2:a500"))

sh2.[E2] = sh3.Cells(AA + 1, 3)
sh2.[E3] = sh3.Cells(AA + 1, 5)
sh2.[E4] = sh3.Cells(AA + 1, 14)
sh2.[k2] = sh3.Cells(AA + 1, 11)
sh2.[k3] = sh3.Cells(AA + 1, 9)
sh2.[K4] = sh3.Cells(AA + 1, 7)
sh2.PrintOut
Next

End Sub

作者: samwang 時間: 2022-8-5 12:49

回復 samwang

Samwang 大大您好:測試結果OK。感謝指點

下列語法是之前套用在函數的陣列跑批次迴圈 ...
keny1021 發表於 2022-8-5 10:57

不好意思，不太了解需求，現在程式碼不是可以產出了嗎? 請再詳細說明一下，謝謝

作者: keny1021 時間: 2022-8-5 15:49 標題: RE: 函數陣列資料如何以以VBA執行

本帖最後由 keny1021 於 2022-8-5 15:53 編輯

回復 6# samwang

Samwang 大大您好:
主要我加入之前的語法套用後，執行後會產生空行，如下面圖一所示:
[attach]35114[/attach]

下面圖二為最終執行的結果:
[attach]35115[/attach]

麻煩看一下語法如何實現，再次感謝

作者: samwang 時間: 2022-8-6 06:59

回復 samwang

Samwang 大大您好:
主要我加入之前的語法套用後，執行後會產生空行，如下面圖一所示:
...
keny1021 發表於 2022-8-5 15:49

請再測試看看，謝謝
If n > 0 Then
With Sheets(2)
.[b1].CurrentRegion.Offset(6) = "" '從第一列往下至第6列後開始刪除
.[b7].Resize(n, 11) = Brr
End With
n = 0
End If
sh2.PrintOut
Next

作者: keny1021 時間: 2022-8-6 11:58

回復 8# samwang

:P 已解決了.太感謝您了

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)