Option Explicit
Sub TEST()
Dim Brr, Z$, X, Q, K$, V0$, V1$, T0$, T1$, i&, M%, Y%
Dim D As Date, P As Date, P1 As Date
Brr = Range([A1], Cells(Rows.Count, 1).End(3))
T0 = [C1]: V0 = Mid(T0, InStr(T0, "_") + 1)
Y = Left(Val(T0), 4): M = Val(Right(Val(T0), 2))
Y = Y + M \ 12: M = M Mod 12 + 1
D = CDate(Y & "/" & M & "/01")
For i = 1 To UBound(Brr)
T1 = Brr(i, 1): V1 = Mid(T1, InStr(T1, "_") + 1)
Y = Left(Val(T1), 4): M = Val(Right(Val(T1), 2))
Y = Y + M \ 12: M = M Mod 12 + 1
P = CDate(Y & "/" & M & "/01") - 1
If (T0 = T1) + (V0 <> V1) + (P > D) Then GoTo i01
If P1 - Date < P - Date Then
P1 = P: Z = Format(P1, "YYYYMM") & "_" & V0
End If
i01: Next
[C4] = IIf(Z <> "", Z, "無")
Erase Brr
End Sub作者: gaishutsusuru 時間: 2023-4-24 21:25
Option Explicit
Function GetSerial(ST$)
Dim Brr, Z$, X, Q, K$, V0$, V1$, T0$, T1$, i&, M%, Y%
Dim D As Date, P As Date, P1 As Date
Brr = Range([A1], Cells(Rows.Count, 1).End(3))
T0 = ST: V0 = Mid(T0, InStr(T0, "_") + 1)
Y = Left(Val(T0), 4): M = Val(Right(Val(T0), 2))
D = CDate(Y & "/" & M & "/01")
For i = 1 To UBound(Brr)
T1 = Brr(i, 1): V1 = Mid(T1, InStr(T1, "_") + 1)
Y = Left(Val(T1), 4): M = Val(Right(Val(T1), 2))
Y = Y + M \ 12: M = M Mod 12 + 1
P = CDate(Y & "/" & M & "/01") - 1
If (T0 = T1) + (V0 <> V1) + (P > D) Then GoTo i01
If P1 - Date < P - Date Then
P1 = P: Z = Format(P1, "YYYYMM") & "_" & V0
End If
i01: Next
GetSerial = IIf(Z <> "", Z, "無")
Erase Brr
End Function作者: hcm19522 時間: 2023-4-25 10:31