- 帖子
- 1425
- 主題
- 40
- 精華
- 0
- 積分
- 1449
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-4-16
|
謝謝論壇,謝謝各位前輩
後學藉此帖複習修訂,學習心得如下,請各位前輩指教
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 |
|
發表於 2024-3-15 09:12
| 
