帖子: 222
主題: 56
精華: 0
積分: 285
點名: 0
作業系統: window
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2010-8-30
最後登錄: 2024-4-22

論壇贊助勳章論壇榮譽勳章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2022-5-4 21:33 | 只看該作者

資料量大的計算

各位先進好
a-i欄位是原始資料
希望在L1和M1儲存格輸入資料篩選條件
只要A-I欄位內容非空白就進行篩選
而將篩選結果顯示在N-P欄位
最後再排版,在V-X欄位將資料由第2列往下排

Image 001.jpg (237.09 KB)

明細.rar (7.8 KB)

樓主熱帖

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2026-5-26

2^#

發表於 2022-5-5 10:30 | 只看該作者

各位先進好
a-i欄位是原始資料
希望在L1和M1儲存格輸入資料篩選條件
只要A-I欄位內容非空白就進行篩選
...
oak0723-1 發表於 2022-5-4 21:33

請測試看看，謝謝
Sub test()
Dim Arr, Brr(), T$, T1$, n&, R&, i&
Arr = Range("a1").CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To 3)
T = [L1] & "|" & [M1]
For i = 2 To UBound(Arr)
T1 = Arr(i, 3) & "|" & Arr(i, 2)
If T = T1 Then
      n = n + 1: If n = 1 Then R = i
      Brr(n, 1) = Application.Text(Arr(i, 4), "00\:00\:00")
      Brr(n, 2) = Arr(i, 5): Brr(n, 3) = Arr(i, 6)
End If
Next
If n > 0 Then
[v1].CurrentRegion.Offset(1).ClearContents
Range("n2:p" & UBound(Arr)).ClearContents
Range("n" & R).Resize(n, 3) = Brr
Range("v2").Resize(n, 3) = Brr
End If
End Sub

TOP

dou10801

中學生 Rank: 2

帖子: 152
主題: 45
精華: 0
積分: 239
點名: 231
作業系統: WIN10
軟體版本: 2010
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2011-6-21
最後登錄: 2026-10-1

2025年全勤獎章 2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章

3^#

發表於 2022-5-5 13:15 | 只看該作者

Sub 按鈕1_Click()
   X = 工作表1.[A65536].End(xlUp).Row
   Y = 2
   MP1 = Range("L1")
   MP2 = Range("M1")
   For i = 1 To X
      If 工作表1.Cells(i, 3) = MP1 And 工作表1.Cells(i, 2) = MP2 Then
         Cells(Y, 14) = Application.Text(工作表1.Cells(i, 4).Value, "00\:00\:00")
         Cells(Y, 15).Resize(, 2).Value = 工作表1.Cells(i, 5).Resize(, 2).Value
         Y = Y + 1
      End If
Next
End Sub
剛在學習,一起研究.

杜小平

TOP

hcm19522

碩士班 Rank: 5 Rank: 5

帖子: 1800
主題: 186
精華: 0
積分: 1991
點名: 0
作業系統: WIN
軟體版本: 2007
閱讀權限: 100
性別: 男
註冊時間: 2015-9-11
最後登錄: 2026-10-1

熱烈參與勳章

4^#

發表於 2022-5-5 13:44 | 只看該作者

https://blog.xuite.net/hcm19522/twblog/590369899

google"EXCEL迷" blog 或google網址:https://hcm19522.blogspot.com/

TOP

oak0723-1

中學生 Rank: 2

帖子: 222
主題: 56
精華: 0
積分: 285
點名: 0
作業系統: window
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2010-8-30
最後登錄: 2024-4-22

論壇贊助勳章論壇榮譽勳章

5^#

發表於 2022-5-5 20:44 | 只看該作者

回復 2# samwang

有點問題,＿

明細-vb01.rar (678.67 KB)

TOP

oak0723-1

中學生 Rank: 2

帖子: 222
主題: 56
精華: 0
積分: 285
點名: 0
作業系統: window
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2010-8-30
最後登錄: 2024-4-22

論壇贊助勳章論壇榮譽勳章

6^#

發表於 2022-5-5 20:47 | 只看該作者

回復 3# dou10801

執行結果有問題
因為版本問題嗎

明細-vb02.rar (678.4 KB)

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2026-5-26

7^#

發表於 2022-5-6 07:43 | 只看該作者

回復 samwang

有點問題,＿
oak0723-1 發表於 2022-5-5 20:44

需求欄位不一樣，修改改如下紅字即可，謝謝
T1 = Arr(i, 1) & "|" & Arr(i, 2) '新的需求

1.JPG (215.85 KB)

TOP

dou10801

中學生 Rank: 2

帖子: 152
主題: 45
精華: 0
積分: 239
點名: 231
作業系統: WIN10
軟體版本: 2010
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2011-6-21
最後登錄: 2026-10-1

2025年全勤獎章 2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章

8^#

發表於 2022-5-6 08:40 | 只看該作者

本帖最後由 dou10801 於 2022-5-6 08:49 編輯

回復 6# oak0723-1
If 工作表1.Cells(i, 3) = MP1 And 工作表1.Cells(i, 2) = MP2 Then .
改 If 工作表1.Cells(i, 1) = MP1 And 工作表1.Cells(i, 2) = MP2 Then

杜小平

TOP

oak0723-1