[發問] 函數陣列資料如何以以VBA執行

keny1021

各位老師好:

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

samwang

回復 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

回復 2# samwang

Samwang 大大 感謝您:

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

samwang

回復  samwang

Samwang 大大 感謝您:

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

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

keny1021

回復 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

回復  samwang

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

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

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

keny1021

回復 6# samwang

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

下載 (402.33 KB)

2022-8-5 15:52

下面圖二為最終執行的結果:

下載 (408.09 KB)

2022-8-5 15:53

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

samwang

回復  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

回復 8# samwang


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