[µo°Ý] ½ÆÂøªº¦ê³s»P¦X¨Ö

°a¤ªºµ

¬Ý¬Ý¦³¨S¦³¤j¤j¯àÀ°¦£
³oÃD¦êÁp¦³Ãø«× ...¤p§Ì¸Ñ¤£¥X¨Ó ...½Ð°Ý¦³¨S¦³¤j¤j¥i¥H¸Ñ³oÃD ·P®¦.~

¤U¸ü (94.37 KB)

2023-6-9 12:37

0609.rar (10.55 KB)

¤U¸ü¦¸¼Æ: 2

2023-6-9 12:32

Andy2483

¦^´_ 3# Andy2483


    «á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð


Option Explicit
Sub TEST_1()
Dim Arr, Brr, Crr, Z, i&, R&, X%, T$, T0$, T1$, T2$, T3$, xR As Range
Set Z = CreateObject("Scripting.Dictionary"): [E:E].ClearContents
Set xR = Range([B1], [A65536].End(3)): Brr = xR
With xR
   For i = 48 To 57
     .Replace Chr(i), " ", LookAt:=2: .Replace "  ", " ", LookAt:=2
   Next
   Arr = xR: xR = Brr
   With .Columns(2)
      .Replace "-", "~", LookAt:=2
      For i = 65 To 90: .Replace Chr(i), "", LookAt:=2: Next
      Crr = xR: xR = Brr
   End With
End With
ReDim Brr(1 To UBound(Brr) * 3, 1 To 1)
For i = 2 To UBound(Crr)
   T = Crr(i, 1): T0 = T
   T = Replace(T & "1|", StrReverse(Val(StrReverse(T & 1))) & "|", "")
   If Z(T) = "" Then
      Z(T) = R * 3 + 1: R = R + 1: Brr(Z(T), 1) = "PO# " & T0
      T1 = Trim(Split(Arr(i, 2) & "-", "-")(0))
      If T1 = "" Then: T1 = Split(Arr(i, 1), " ")(0)
      If InStr(T1, " ") = 0 Then T1 = T1 & " "
      Z(T & "|e") = T1: Z(T & "|n") = Crr(i, 2)
   End If
   If InStr(Brr(Z(T), 1), T0) = 0 Then Brr(Z(T), 1) = Brr(Z(T), 1) & "/" & T0
   Z(T & "|n") = Z(T & "|n") & "," & Crr(i, 2)
   T2 = Z(T & "|n"): T3 = N_L(T2, "~", ",")
   If T3 = "" Then
      Brr(Z(T) + 1, 1) = "#VALUE!"
      Else
      T2 = Replace(Z(T & "|e"), " ", "(" & N_L(T2, "~", ",") & ")")
      Brr(Z(T) + 1, 1) = "C/NO. " & Replace(T2, "~", "-")
   End If
Next
[E2].Resize(R * 3 - 1, 1) = Brr
Set Z = Nothing: Set xR = Nothing: Erase Arr, Brr, Crr
End Sub

Andy2483

¦^´_ 2# °a¤ªºµ


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß¦r¨å»P¦Û­q¨ç¼Æ,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

°õ¦æµ²ªG:

¤U¸ü (45.94 KB)

2023-6-12 09:51

Option Explicit
Sub TEST()
MsgBox N_L("235-237,238", "-", ",") & vbLf & vbLf _
   & N_L("235~237;238;236~240;260~261;25", "~", ";")
End Sub
Function N_L(¼Æ¦r¦ê$, ³sÄò²Å$, ¶¡¹j²Å$) As String
Dim A, Z, V, i&, X&, Mi&, Ma&, N&, T$
Set Z = CreateObject("Scripting.Dictionary")
If InStr(¼Æ¦r¦ê, ¶¡¹j²Å) = 0 Or Val(¼Æ¦r¦ê) = 0 Then N_L = "": Exit Function
On Error GoTo Rear
For Each A In Split(Replace(¼Æ¦r¦ê, ³sÄò²Å, "-"), ¶¡¹j²Å)
   A = A & "-" & A: A = Split(A, "-")(0) & "-" & Split(A, "-")(1)
   For i = 0 To Abs(Evaluate(A))
      V = Val(A) + i
      If N = 0 Then Mi = V: Ma = Mi: N = 1
      Z(V) = 1
      If V < Mi Then Mi = V Else: If V > Ma Then Ma = V
   Next
Next
For i = Mi To Ma
   If Z(i) <> "" And X = 0 Then T = T & ¶¡¹j²Å & i: X = 1
   If Z(i + 1) = "" And X = 1 Then X = 0:  GoTo i01
   If Z(i + 1) = "" And X > 1 Then T = T & ³sÄò²Å & i: X = 0
   If Z(i) <> "" Then X = X + 1
i01: Next
Rear: If Err.Number = 0 Then N_L = Mid(T, 2) Else: N_L = ""
Set Z = Nothing
End Function

°a¤ªºµ

³oÃD ¥d¦b ¦p¦ó§PÂ_ ¦P¤@²Õ¼Æ¦r ¬O¤£¬O³s¸¹ ¦pªG¬O ¦p¦ó¨ú¥N³Ì¤j­È ¦pªG¤£¬O Ä~Äò¦êÁp