返回列表 上一主題 發帖

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

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

各位老師好:

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

Isp-test.zip (725.75 KB)

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

TOP

回復 2# samwang

Samwang 大大 感謝您:

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

Isp-test-2.zip (725.34 KB)

TOP

回復  samwang

Samwang 大大 感謝您:

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


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

TOP

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

Isp-test-3.zip (727.62 KB)

Isp-test-3.zip (751.03 KB)

TOP

回復  samwang

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

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


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

TOP

RE: 函數陣列資料如何以以VBA執行

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

回復 6# samwang

Samwang 大大 您好:
主要我加入之前的語法套用後,執行後會產生空行,如下面圖一所示:
messageImage_1659675964432.jpg
2022-8-5 15:52


下面圖二為最終執行的結果:
messageImage_1659676265755.jpg
2022-8-5 15:53




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

Isp-test-3.zip (727.62 KB)

TOP

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

TOP

回復 8# samwang


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

TOP

        靜思自在 : 世上有兩件事不能等:一、孝順 二、行善。
返回列表 上一主題