Option Explicit
Sub test_20221213()
Dim Brr, i&, X&, V, Y, Z$(5), A$, N&, j&, R&, C$, Q#(99), P, M#, K&
Set Y = CreateObject("Scripting.Dictionary")
Brr = Range([D3], Cells(Rows.Count, "D").End(3))
For i = 1 To UBound(Brr)
A = Replace(Replace(Replace(Brr(i, 1), " 長", ","), "、", ","), " ", ",")
V = Split(A, ",")
R = R + 1
N = 0
P = Q
For j = 0 To UBound(V)
If V(j) = "" Then
M = Application.Max(P)
For K = 1 To N
C = "'" & R & "." & K
P = Y(C)
If P(4) = M Then
P(5) = "V"
Y(C) = P
End If
Next
Exit For
End If
X = j Mod 4
N = IIf(X = 0, N + 1, N)
If X = 0 Then C = "'" & R & "." & N: Z(X) = C
Z(X + 1) = V(j)
If X = 3 Then P(N) = V(j): Y(C) = Z
Next
Next
Workbooks.Add
[A1].Resize(1, 6) = [{"N0","日期","時間","規格","數值","MX"}]
[A2].Resize(Y.Count, 6) = Application.Transpose(Application.Transpose(Y.ITEMS))
[B:B].NumberFormatLocal = "yyyy/m/d"
Cells.Columns.AutoFit
End Sub作者: Andy2483 時間: 2022-12-14 08:59
Sub test_20221214()
AC_WO_NA = ActiveWorkbook.Name
Workbooks.Add
[A1] = "N0"
[B1] = "日期"
[C1] = "時間"
[D1] = "規格"
[E1] = "數值"
[F1] = "MX"
N = 1
With Workbooks(AC_WO_NA).Sheets("SOS")
For i = 3 To .[D65536].End(xlUp).Row
If .Cells(i, "D") Like "*##/## *:* *-* 長* *#*、*" = True Then
R = R + 1
C = 0
For j = 1 To Len(.Cells(i, "D"))
If Mid(.Cells(i, "D"), j, 5) Like "##/##" = True Then
C = C + 1
N = N + 1
Cells(N, 1) = "'" & R & "." & C
Cells(N, 2) = Mid(.Cells(i, "D"), j, 5)
End If
If Mid(.Cells(i, "D"), j, 5) Like "##:##" = True Then
Cells(N, 3) = Mid(.Cells(i, "D"), j, 5)
End If
If Mid(.Cells(i, "D"), j, 99) Like " AA-* 長*" = True Then
Cells(N, 4) = Mid(.Cells(i, "D"), j + 1, InStr(Mid(.Cells(i, "D"), j, 99), " 長") - 2)
End If
If Mid(.Cells(i, "D"), j, 99) Like " 長#*、*" = True Then
Cells(N, 5) = Mid(.Cells(i, "D"), j + 2, InStr(Mid(.Cells(i, "D"), j, 99), "、") - 3)
End If
Next
End If
Next
End With
M = 0
For i = 2 To [A65536].End(xlUp).Row + 1
If Mid(Cells(i, 1), 1, InStr(Cells(i, 1), ".")) = Mid(Cells(i + 1, 1), 1, InStr(Cells(i + 1, 1), ".")) Then
If Cells(i, 5) > M Then
N = i
M = Cells(i, 5)
End If
If Cells(i + 1, 5) > M Then
N = i + 1
M = Cells(i + 1, 5)
End If
Else
Cells(N, 6) = "V"
M = 0
End If
Next
[B:B].NumberFormatLocal = "yyyy/m/d"
Cells.Columns.AutoFit
End Sub
