Board logo

標題: 大量資料計算 [打印本頁]
作者: oak0723-1    時間: 2021-10-5 18:40     標題: 大量資料計算

本帖最後由 oak0723-1 於 2021-10-5 18:41 編輯

大量數十萬列資料計算
檔案開關慢用函數處理又易當機
麻煩先進能協助
另外請問有較粗淺的vba陣列相關文章可以學習嗎
還有
我這個附件為何會那麼大?如何縮小
作者: samwang    時間: 2021-10-6 08:01

回復 1# oak0723-1

不好意思，看不懂您真的需求為何? 可否在詳細說明一下
建議移除您的公式這樣檔案才不會那麼大，
另外請問有較粗淺的vba陣列相關文章可以學習嗎>> 網路找一下應該很多
謝謝
作者: oak0723-1    時間: 2021-10-6 10:06

回復 2# samwang
你好
感謝你對我的問題關注
我怕移除我自己所寫的函數公式更會無法把問題講清楚
我的問題就是希望用巨集來完成我函數想完成的內容
只是我“資料庫“工作表的資料數量是不固定的，
“比對“工作表第三列裡的比對資料數量也是不固定
只要兩邊有資料就進行比對,比對結果是一樣的就顯示1，不一樣就顯示0,沒資料就空白
作者: oak0723-1    時間: 2021-10-6 12:50

回復 2# samwang


    補充圖片說明
作者: samwang    時間: 2021-10-6 14:08

回復 4# oak0723-1

請測試看看，謝謝
Sub test()
Dim Arr, Drr, Brr(), Crr(), T, T1, T2
Tm = Timer
Arr = Range([資料庫!b6], [資料庫!b65536].End(3))
Drr = Sheets("資料庫").Range("i6:ama" & UBound(Arr) + 5)
[比對!b6].Resize(UBound(Arr)) = Arr
ReDim Brr(1 To UBound(Arr), 1 To 1000)
ReDim Crr(1 To UBound(Arr), 1 To 1)
With Sheets("比對")
    Arr = .Range("i3:alt3")
    For i = 1 To UBound(Drr)
        Crr(i, 1) = 0
        For j = 1 To UBound(Arr, 2)
            T = Arr(1, j): T1 = Drr(i, j): T2 = Drr(i, j + 6)
            If T = "" Or T1 = "" Then Brr(i, j) = "": GoTo 99
            If T = T2 Then
                Brr(i, j) = 1: Crr(i, 1) = Crr(i, 1) + 1
            Else
                 Brr(i, j) = 0
            End If
99:     Next j
    Next i
    .Range("h6").Resize(UBound(Crr)) = Crr
    .Range("i6").Resize(UBound(Brr), UBound(Brr, 2)) = Brr
End With
MsgBox Timer - Tm
End Sub
作者: oak0723-1    時間: 2021-10-6 22:52

回復 5# samwang
執行結果有點怪怪的
因為
工作表"資料庫" i6儲存格=1001
工作表"比對" i3儲存格=1001,故工作表"比對" i6 儲存格應該是 1 才對,不是 0

是否我有作錯甚麼
作者: oak0723-1    時間: 2021-10-7 06:23

回復 6# oak0723-1


    為了表達更清楚
我是用函數寫了附件檔案
這個函數檔案就是我想用vba完成的
作者: samwang    時間: 2021-10-7 08:09

本帖最後由 samwang 於 2021-10-7 08:12 編輯

回復 7# oak0723-1

修改如下，請再測試看看，謝謝
If T = "" Or T1 = "" Then Brr(i, j) = "": GoTo 99
修改為--> If T = "" Then Brr(i, j) = "": GoTo 99
If T = T2 Then
修改為--> If T = T1 Then
作者: samwang    時間: 2021-10-7 11:50

回復 6# oak0723-1

您的#1、#7規則條件不一樣如圖片，#1條件已回覆#5，#7條件已回覆#8，請再確認，謝謝
作者: oak0723-1    時間: 2021-10-7 19:52

回復 9# samwang
目前已完全符合我的需求
同樣規則可否比對有上限下限二組數據,如附件
感恩
作者: oak0723-1    時間: 2021-10-8 07:12

回復 10# oak0723-1


    因問題類似
所以就在這兒一併求解
作者: samwang    時間: 2021-10-8 07:25

回復 10# oak0723-1

您的公式的條件與描述條件不一樣如照片，請問哪個是正確?
另外請問上下限的定義是對的嗎? 舉例上限1001，下限1006，數字要對調吧? 正確上限1006、下限1001
作者: samwang    時間: 2021-10-8 11:09

回復 10# oak0723-1

數值若在於上下限界內則為1,若低於下限或高於上限則顯示 0
如下，請測試看看，謝謝

Sub test()
Dim Arr, Drr, Brr(), Crr(), T, XMax, XMin
Tm = Timer
Arr = Range([資料庫!b6], [資料庫!b65536].End(3))
'Drr = Sheets("資料庫").Range("i6:ama" & UBound(Arr) + 5)
Drr = Sheets("資料庫").Range("i6:p" & UBound(Arr) + 5)
[比對!b6].Resize(UBound(Arr)) = Arr
ReDim Brr(1 To UBound(Arr), 1 To 8) '1 to 1000
ReDim Crr(1 To UBound(Arr), 1 To 1)
With Sheets("比對")
    Arr = .Range("i3:p4")
    For i = 1 To UBound(Drr)
        Crr(i, 1) = 0
        For j = 1 To UBound(Arr, 2)
            T = Drr(i, j): XMin = Arr(1, j): XMax = Arr(2, j)
            If XMin = "" Or T = "" Then Brr(i, j) = "": GoTo 99
            If T < XMin Or T > XMax Then
                Brr(i, j) = 0
            Else
                 Brr(i, j) = 1: Crr(i, 1) = Crr(i, 1) + 1
            End If
99:     Next j
    Next i
    .Range("h6").Resize(UBound(Crr)) = Crr
    .Range("i6").Resize(UBound(Brr), UBound(Brr, 2)) = Brr
End With
MsgBox Timer - Tm
End Sub
作者: oak0723-1    時間: 2021-10-8 18:16

回復 13# samwang
你好
測試一下發現有些問題
我增加資料列數和欄數
發現不能隨增減資料數變動比對結果
如附件說明
作者: samwang    時間: 2021-10-9 05:47

回復 14# oak0723-1

我增加資料列數和欄數
發現不能隨增減資料數變動比對結果
>> 已更新，請再測試看看，謝謝
   
Sub test()
Dim Arr, Drr, Brr(), Crr(), T, XMax, XMin, R%, C%
Tm = Timer
With Sheets("資料庫")
    R = .[b6].End(4).Row
    C = .Cells(5, Columns.Count).End(1).Column
    Arr = .Range(.[b6], .Cells(R, 2))
    Drr = .Range(.[i6], .Cells(R, C))
End With
With Sheets("比對")
    .[b6].Resize(UBound(Arr)) = Arr
    ReDim Brr(1 To UBound(Arr), 1 To UBound(Drr, 2))
    ReDim Crr(1 To UBound(Arr), 1 To 1)
    C = .Cells(3, Columns.Count).End(1).Column
    Arr = .Range(.[i3], .Cells(4, C))
    For i = 1 To UBound(Drr)
        Crr(i, 1) = 0
        For j = 1 To UBound(Arr, 2)
            T = Drr(i, j): XMin = Arr(1, j): XMax = Arr(2, j)
            If XMin = "" Or T = "" Then Brr(i, j) = "": GoTo 99
            If T < XMin Or T > XMax Then
                Brr(i, j) = 0
            Else
                 Brr(i, j) = 1: Crr(i, 1) = Crr(i, 1) + 1
            End If
99:     Next j
    Next i
    .Range("h6").Resize(UBound(Crr)) = Crr
    .Range("i6").Resize(UBound(Brr), UBound(Brr, 2)) = Brr
End With
MsgBox Timer - Tm
End Sub
作者: oak0723-1    時間: 2021-10-9 14:23

回復 15# samwang


    你好
感謝你願熱心幫忙
目前測試執行發生"陣列索引超出範圍"的問題
作者: samwang    時間: 2021-10-10 12:44

回復 16# oak0723-1


  目前測試執行發生"陣列索引超出範圍"的問題
>> 因為資料庫與比對的欄位不一致導致問題，已更新新增1列如下紅字，請再測試看看，謝謝

...
...
With Sheets("比對")
    .[b6].Resize(UBound(Arr)) = Arr
    ReDim Brr(1 To UBound(Arr), 1 To UBound(Drr, 2))
    ReDim Crr(1 To UBound(Arr), 1 To 1)
    C1 = .Cells(3, Columns.Count).End(1).Column
    If C1 > C Then C = C Else C = C1
    Arr = .Range(.[i3], .Cells(4, C))
    For i = 1 To UBound(Drr)
...
...



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