Andy2483

回復 16# cdkee


    謝謝前輩發表此主題與範例,謝謝各位前輩
後學練習以2個陣列方式處裡,請各位前輩指導

執行前:

下載 (102.51 KB)

2023-3-10 10:57

執行結果:

下載 (152.04 KB)

2023-3-10 10:57

Option Explicit
Sub TEST()
Dim Brr, Crr, Z, i&, N&, j&, T$
Brr = Range([G1], Cells(Rows.Count, "A").End(3))
ReDim Crr(1 To UBound(Brr) * 2, 1 To UBound(Brr, 2))
For i = 1 To UBound(Brr)
   T = Brr(i, 2)
   If InStr("/9:16:000/13:31:000/", "/" & T & "/") Then
      N = N + 1
      Crr(N, 1) = Brr(i, 1): Z = Split(T, ":")
      Crr(N, 2) = Join(Array(Z(0), Z(1) - 1, Z(2)), ":")
      For j = 3 To 6
         Crr(N, j) = Brr(i, 3)
      Next
   End If
   N = N + 1
   For j = 1 To UBound(Brr, 2)
      Crr(N, j) = Brr(i, j)
   Next
Next
[J1].Resize(N, UBound(Crr, 2)) = Crr
Erase Brr, Crr
End Sub

Andy2483

回復 17# Andy2483


    後學延伸練習以字典+二維陣列+一維陣列 處裡,請各位前輩指導

Option Explicit
Sub TEST_2()
Dim Brr, Z, Y, B, i&, N&, j&, T$, A(6)
Set Y = CreateObject("Scripting.Dictionary")
Brr = Range([G1], Cells(Rows.Count, "A").End(3))
For i = 1 To UBound(Brr)
   T = Brr(i, 2)
   If InStr("/9:16:000/13:31:000/", "/" & T & "/") Then
      N = N + 1: B = A
      B(0) = Brr(i, 1): Z = Split(T, ":")
      B(1) = Join(Array(Z(0), Z(1) - 1, Z(2)), ":")
      For j = 2 To 5
         B(j) = Brr(i, 3)
      Next
      Y(N) = B
   End If
   N = N + 1: B = A
   For j = 0 To UBound(B)
      B(j) = Brr(i, j + 1)
   Next
   Y(N) = B
Next
[J1].Resize(N, UBound(A) + 1) = Application.Transpose(Application.Transpose(Y.Items))
Erase Brr, B, A: Set Y = Nothing
End Sub

Andy2483

回復 18# Andy2483


    謝謝論壇,謝謝各位前輩
後學複習心得如下,請各位前輩指教

Option Explicit
Sub TEST_1()
Dim Brr, Crr, Z, i&, N&, j&, T$
'↑宣告變數:(Brr,Crr,Z)是通用型變數,(i,N,j)是長整數變數,T是字串變數
Brr = Range([G1], Cells(Rows.Count, "A").End(3))
'↑令Brr這通用型變數是二維陣列,以[G1]到A欄最後有內容儲存格值帶入
ReDim Crr(1 To UBound(Brr) * 2, 1 To UBound(Brr, 2))
'↑宣告Crr是二維陣列,範圍大小,縱向從1到Brr陣列縱向最大索引列號數的2倍,
'橫向從1到 Brr陣列橫向最大索引欄號數
For i = 1 To UBound(Brr)
'↑設順迴圈!i從1到 Brr陣列縱向為大索引列號
   T = Brr(i, 2)
   '↑令T這字串變數是 i迴圈列第2欄Brr陣列值
   If InStr("/9:16:000/13:31:000/", "/" & T & "/") Then
   '↑如果T變數的前後各連接"/"符號後的新字串,在指定的字串裡被包含了??
   '指定的字串:"/9:16:000/13:31:000/"
      N = N + 1
      '↑令N這長整數變數累加1
      Crr(N, 1) = Brr(i, 1): Z = Split(T, ":")
      '↑令N變數列第1欄Crr陣列值是 i迴圈列第1欄Brr陣列值:
      '令Z變數是一維陣列,令T變數以":"分割後帶入
      Crr(N, 2) = Join(Array(Z(0), Z(1) - 1, Z(2)), ":")
      '↑令N變數列第2欄Crr陣列值是
      '(第0索引Z陣列值,第1索引Z陣列值-1,第2索引Z陣列值)
      '這三個字串以":"串接成新字串
      For j = 3 To 6
      '↑設順迴圈!j從3到6
         Crr(N, j) = Brr(i, 3)
         '↑令N變數列第j迴圈欄Crr陣列值是 i變數列第3欄Brr陣列值
      Next
   End If
   N = N + 1
   '↑令N變數累加1
   For j = 1 To UBound(Brr, 2)
   '↑設順迴圈!j從1到Brr陣列橫向最大索引欄號數
      Crr(N, j) = Brr(i, j)
      '↑令N變數列第j迴圈欄Crr陣列值是 i變數列第j迴圈欄Brr陣列值
   Next
Next
[J1].Resize(N, UBound(Crr, 2)) = Crr
'↑令[J1]擴展向下N變數列,擴展向右Crr橫向最大所欄號數,
'這範圍儲存格值以 Crr陣列值帶入
Erase Brr, Crr, Z
'↑令釋放變數
End Sub

==========================================================

Option Explicit
Sub TEST_2()
Dim Brr, Z, Y, B, i&, N&, j&, T$, A(6)
'↑宣告變數:(Brr,Z,Y,B)是通用型變數,(i,N,j)是長整數變數,T是字串變數,
'A是一維陣列(0~6)空陣列
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y這通用型變數是 字典
Brr = Range([G1], Cells(Rows.Count, "A").End(3))
'↑令Brr這通用型變數是二維陣列,以[G1]到A欄最後有內容儲存格值帶入
For i = 1 To UBound(Brr)
'↑設順迴圈!i從1到 Brr陣列縱向最大索引列號
   T = Brr(i, 2)
   '↑令T這字串變數是 i迴圈列第2欄Brr陣列值
   If InStr("/9:16:000/13:31:000/", "/" & T & "/") Then
   '↑如果T變數的前後各連接"/"符號後的新字串,在指定的字串裡被包含了??
   '指定的字串:"/9:16:000/13:31:000/"
      N = N + 1: B = A
      '↑令N這長整數變數累加1:令B這通用型變數是A這空陣列
      B(0) = Brr(i, 1): Z = Split(T, ":")
      '↑令0索引號B陣列值是 i迴圈列第1欄Brr陣列值:
      '令Z變數是一維陣列,令T變數以":"分割後帶入
      B(1) = Join(Array(Z(0), Z(1) - 1, Z(2)), ":")
      '↑令0索引號B陣列值是
      '(第0索引Z陣列值,第1索引Z陣列值-1,第2索引Z陣列值)
      '這三個字串以":"串接成新字串
      For j = 2 To 5
      '↑設順迴圈!j從2到 5
         B(j) = Brr(i, 3)
         '↑令j索引號B陣列值是 i迴圈列第3欄Brr陣列值
      Next
      Y(N) = B
      '↑令N變數為key,item是B變數納入Y字典裡
   End If
   N = N + 1: B = A
   '↑令N變數累加1 :令B變數是A變數
   For j = 0 To UBound(B)
   '↑設順迴圈!j從0到 B陣列最大索引號
      B(j) = Brr(i, j + 1)
      '↑令j迴圈B陣列值是 i迴圈列第j迴圈+1欄Brr陣列值
   Next
   Y(N) = B
   '↑令N變數為key,item是B變數納入Y字典裡
Next
[J1].Resize(N, UBound(A) + 1) = Application.Transpose(Application.Transpose(Y.Items))
'↑令[J1]擴展向下N變數列,擴展向右A陣列最大索引號+1欄,
'這範圍儲存格值以 Y字典的item轉置兩次帶入
Erase Brr, B, A, Z: Set Y = Nothing
'↑令釋放變數
End Sub