返回列表 上一主題 發帖

[發問] 請問能否用VBA或函數同時完成欄位尋找+比較大小?

[發問] 請問能否用VBA或函數同時完成欄位尋找+比較大小?

本帖最後由 GGGYYY 於 2024-3-14 16:30 編輯

請問能否用VBA或函數同時完成欄位尋找+比較大小問題?

由"參照數值"找尋"日期表"內(H)欄位是否有相同值,並比較(O)欄位大小挑選最大值的列位複製到"提取資料"表內。
參照數值會非固定值,會依需求更改,無找不到值,則NA帶入
目前透過排序比較大小,刪除數值小的後,再透過函數協助處理,但資料一多還是有點費時。
請問能否提供比較好的方法供參考?

附上範例示意檔
BOOK_TEST.zip (7.82 KB)

回復 1# GGGYYY

謝謝前輩發表此主題與範例
後學藉此帖練習陣列.Evaluate()與 以字典記錄列號的方法,學習方案如下,請前輩參考
執行結果:
20240315_1.jpg
2024-3-15 09:09


Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, V, Z, i&, j%, R&, T$, TT$, xS As Worksheet
Set Z = CreateObject("Scripting.Dictionary")
Brr = [日期!A1].CurrentRegion: Set xS = Sheets("提取資料"): xS.UsedRange.Offset(1).EntireRow.Delete
For i = 2 To UBound(Brr)
   T = Brr(i, 8): V = Brr(i, 15): TT = i & "^0*" & Val(V)
   If Not Z.EXISTS(T) Then Z(T) = TT Else Z(T) = IIf(Val(V) > Evaluate(Z(T)), TT, Z(T))
Next
ReDim Arr(1 To UBound(Brr), 1 To UBound(Brr, 2)): Crr = [參照數值!A1].CurrentRegion
For i = 2 To UBound(Crr)
   T = Crr(i, 1): Crr(i, 1) = ""
   If Not Z.EXISTS(T) Then
      Arr(i - 1, 1) = "NA": Crr(i, 1) = "NA": Arr(i - 1, 8) = T
      Else
      R = Split(Z(T), "^")(0): For j = 1 To UBound(Brr): Arr(i - 1, j) = Brr(R, j): Next
   End If
Next
With Sheets("參照數值")
   .UsedRange.Offset(, 1).EntireColumn.Delete
   .[B1].Resize(UBound(Crr)) = Crr: .[B1] = "NA註記"
End With
With xS.[A2].Resize(UBound(Crr) - 1, UBound(Arr, 2))
   .Value = Arr: Application.Goto xS.[A1]
   .Columns(2).NumberFormat = "hh:mm:ss"
End With
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

(搜尋編號12528) google網址:https://hcm19522.blogspot.com/
google"EXCEL迷"  blog  或google網址:https://hcm19522.blogspot.com/

TOP

本帖最後由 Andy2483 於 2024-3-19 08:13 編輯

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列.Large()與字典記錄列號,學習列出"日期"表O欄前10大值資料列
執行結果:
20240315_2.jpg
2024-3-15 13:56


Option Explicit
Sub TEST_1()
Dim Arr, Brr, V, Q, Z, i&, j%, N&, a%, xS As Worksheet
Set Z = CreateObject("Scripting.Dictionary")
Brr = [日期!A1].CurrentRegion: Set xS = Sheets("提取資料"): xS.UsedRange.Offset(1).EntireRow.Delete
For i = 2 To UBound(Brr)
   V = Brr(i, 15): V = Val(V)
   If Not Z.EXISTS(V) Then Z(V) = i Else Z(V) = Z(V) & "/" & i
Next
ReDim Arr(1 To UBound(Brr), 1 To UBound(Brr, 2) + 1)
For i = 1 To 10
   Q = Application.Large(Z.keys, i)
   V = Split("/" & Z(Q), "/")
   For a = 1 To UBound(V)
      N = N + 1: Arr(N, 1) = i: For j = 1 To UBound(Brr, 2): Arr(N, j + 1) = Brr(Val(V(a)), j): Next
   Next
Next
With xS.[A2].Resize(N, UBound(Arr, 2))
   .Value = Arr: Application.Goto xS.[A1]: .Columns(3).NumberFormat = "hh:mm:ss"
End With
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

感謝Andy大的幫忙,實測後 完全符合需求~
還學到不用透過排序方式就能快速找出最大值方式~
太感謝您了~

TOP

hcm19522大的函數部分 也不錯用,學習了~
太感謝了!!!

TOP

Andy大,發現一個小問題,當來源資料大於59筆時,運行會出現錯誤
是陣列部分的問題嗎?

>59

60.jpg
2024-3-18 15:25

next.jpg
2024-3-18 15:29

TOP

回復 7# GGGYYY

謝謝前輩回復
後學糊塗,請修改如下試試看:
R = Split(Z(T), "^")(0): For j = 1 To UBound(Brr, 2): Arr(i - 1, j) = Brr(R, j): Next
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

再次感謝Andy大,實測可正常運行了~

TOP

謝謝論壇,謝謝各位前輩
後學藉此帖複習修訂,學習心得如下,請各位前輩指教

Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, V, Z, i&, j%, R&, T$, TT$, xS As Worksheet
'↑宣告變數:&是長整數,$是字串變數,%是短整數,沒有指定的是通用型變數
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z變數是 字典
Brr = [日期!A1].CurrentRegion: Set xS = Sheets("提取資料"): xS.UsedRange.Offset(1).EntireRow.Delete
'↑令Brr變數是 以工作表儲存格值帶入的二維陣列,令xS變數是(物件)"提取資料"工作表
'令舊資料刪除,只留下標題列

For i = 2 To UBound(Brr)
'↑設順迴圈!i從2 到Brr陣列縱向最大索引列號
   T = Brr(i, 8): V = Brr(i, 15): TT = i & "^0*" & Val(V)
   '↑令T變數是i迴圈列8欄Brr陣列值,令V變數是i迴圈列15欄Brr陣列值
   '令TT變數是迴圈數i 連接"^0*"字串,再連接V變數轉數值所組成的新字串

   If Not Z.EXISTS(T) Then Z(T) = TT Else Z(T) = IIf(Val(V) > Evaluate(Z(T)), TT, Z(T))
   '↑如果Z字典裡沒有T變數key!就令以T為key,item是TT變數納入Z字典中,
   '否則就令以T為key,item是IIf()回傳值

Next
ReDim Arr(1 To UBound(Brr), 1 To UBound(Brr, 2)): Crr = [參照數值!A1].CurrentRegion
'↑宣告Arr變數是二維空陣列,宣告其陣列範圍,令Crr陣列是 以工作表儲存格值帶入的二維陣列
For i = 2 To UBound(Crr)
'↑設順迴圈!i從2 到Crr陣列縱向最大索引列號
   T = Crr(i, 1): Crr(i, 1) = ""
   '↑令T變數是i迴圈列1欄Crr陣列值,令i迴圈列1欄Crr陣列值是空字元
   If Not Z.EXISTS(T) Then
   '↑如果Z字典裡沒有T變數key??
      Arr(i - 1, 1) = "NA": Crr(i, 1) = "NA": Arr(i - 1, 8) = T
      '↑令找不到關鍵字列註記欄寫入"NA"字串
      Else
      R = Split(Z(T), "^")(0): For j = 1 To UBound(Brr, 2): Arr(i - 1, j) = Brr(R, j): Next
      '↑令R變數是 Z字典記錄的列號!設順迴圈將Brr資料寫入Arr陣列裡
   End If
Next
With Sheets("參照數值")
   .UsedRange.Offset(, 1).EntireColumn.Delete
   '↑令"參照數值"表只留下標題欄,其餘欄位刪除
   .[B1].Resize(UBound(Crr)) = Crr: .[B1] = "NA註記"
   '↑令B欄寫入"NA"註記
End With
With xS.[A2].Resize(UBound(Crr) - 1, UBound(Arr, 2))
'↑以下是關於"提取資料"表從[A2]儲存格擴展指定範圍儲存格的程序
   .Value = Arr: Application.Goto xS.[A1]
   '↑令Arr陣列值寫入 "提取資料"表,令游標跳到"提取資料"表[A1]儲存格
   .Columns(2).NumberFormat = "hh:mm:ss"
   '↑令該範圍第2欄格式為2碼時:分:秒
End With
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 君子立恆志,小人恆立志。
返回列表 上一主題