Andy2483

¦^´_ 3# gaishutsusuru


    ÁÂÁ½׾Â,ÁÂÁ«e½ú¦^´_
¤½¦¡«ÜÃø,«á¾ÇÁÙ¨S¨º­Ó¥\¤O³]­p,¥H¤U¬O±N#2¼Ó§ï¦¨¦Û­q¨ç¼Æªº¾Ç²ß¤è®×,½Ð«e½ú°Ñ¦Ò

¨Ï¥Î¤è¦¡»Pµ²ªG:

¤U¸ü (59.56 KB)

2023-4-25 07:48

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, "µL")
Erase Brr
End Function

gaishutsusuru

¦^´_ 2# Andy2483

ÁÂÁÂAndy2483¤j¤jªº©âªÅÀ°¦£¡C§Ú¦A¨Ó¸Õ¬Ý¬Ý¡C

·Q½Ð°Ý¦pªG¥Î¤½¦¡ªº¸Ü¡A¤£ª¾¹D¯à§_¹F¦¨©O? ÁÂÁÂ

Andy2483

¦^´_ 1# gaishutsusuru


    ÁÂÁ½׾Â,ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ßVBAªº¤èªk,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

°õ¦æµ²ªG:

¤U¸ü (34.94 KB)

2023-4-24 16:40

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, "µL")
Erase Brr
End Sub