­ã´£³¡ªL

Sub TEST()
Dim Arr, V&, U1&, U2&, i&, j%, T$
Arr = Range([A1], [m65536].End(xlUp))
For i = 1 To UBound(Arr)
    V = -9 ^ 9
    For j = 1 To UBound(Arr, 2)
        U1 = Arr(i, j):  U2 = U1
        If j < UBound(Arr, 2) Then U2 = Arr(i, j + 1)
        If U1 - V = 1 Or U2 - U1 = 1 Then T = T & "," & U1: V = U1
    Next j
    Arr(i, 1) = Mid(T, 2): T = ""
Next i
[O1].Resize(UBound(Arr)) = Arr
End Sub

­ã´£³¡ªL

P1//°}¦C¤½¦¡(¤TÁä¿é¤J)
=iferror(SMALL(IF(MMULT({1,1},COUNTIF($A1:$M1,$A1:$M1+{1;-1}))>0,--$A1:$M1),COLUMN(A1)),"")

samwang

¦^´_ 1# f00l01

³sÄò¼Æ¦r³æ¿W­Ó§O©ñ¦b³æ¤@Àx¦s®æ¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁ¡C
Sub tt1()
Dim Arr, Brr(), T%, T1%, L%, M%, i&, j&
Columns("O:AA").ClearContents
Arr = [a1].CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr)
    M = 0: L = 0
    For j = 1 To UBound(Arr, 2)
        If j + 1 > UBound(Arr, 2) Then
            If T1 = T + 1 Then M = M + 1: Brr(i, M) = Arr(i, j)
            Exit For
        End If
        T = Arr(i, j): T1 = Arr(i, j + 1)
        If T1 = T + 1 Then
            M = M + 1: Brr(i, M) = Arr(i, j)
        Else
            If T > L + 1 Then GoTo 99
            M = M + 1: Brr(i, M) = Arr(i, j)
        End If
        L = T
99:  Next
Next
Range("o1").Resize(UBound(Brr), UBound(Brr, 2)) = Brr
End Sub

hcm19522

https://blog.xuite.net/hcm19522/twblog/589693174

f00l01

·Q¤£¨ì°Ý¨­Ã䪺¤H³£¸Ñ¤£¥X¨Óªº°ÝÃD

¨Ó³Â»¶®a±Ú°Q½×°Ï¶}°Ý¤@¤U¤l´N¸õ¥X¤j¯«À°¦£~~

·PÁ  quickfixer (¶W§Ö¡I) ÁÙ¦³ ML089 ªº¨â¦¸¶K¤å¸Ô¸Ñ

¤]­nÁÂÁ jcchiang¡B samwang ´£¨Ñ¸Ñ¤è

§Ú²{¦b³£¨Ó¸Õ¸Õ¬Ý¡A¦³°ÝÃD¦A«e¨Ó«ô°Ý

¦A¤@¦¸ÁÂÁÂÀ°¦£ªº¦U¼h¼Ó¥D©M³Â»¶®a±Úªº¹Î¶¤¡I

samwang

¦^´_ 1# f00l01

¤£ª¾¹D¬O§_¬°¼Ó¥D»Ý¨D¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁ¡C
Sub tt()
Dim Arr, Brr(), T%, T1%, L%, M%, i&, j&, C%
Columns("O:AA").ClearContents
Arr = [a1].CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr)
    M = 0: L = 0: C = 0
    For j = 1 To UBound(Arr, 2)
        If j + 1 > UBound(Arr, 2) Then
            If T1 = T + 1 Then Brr(i, M) = Mid(Brr(i, M) & "," & Arr(i, j), 2)
            Exit For
        End If
        T = Arr(i, j): T1 = Arr(i, j + 1)
        If T1 = T + 1 Then
            If C = 0 Then M = M + 1
            Brr(i, M) = Brr(i, M) & "," & Arr(i, j): C = 1
        Else
            If T > L + 1 Then GoTo 99
            Brr(i, M) = Mid(Brr(i, M) & "," & Arr(i, j), 2): C = 0
        End If
        L = T
99:  Next
Next
Range("o1").Resize(UBound(Brr), UBound(Brr, 2)) = Brr
End Sub

jcchiang

¦^´_ 1# f00l01

¸Õ¸Õ¬Ý
Sub ex()
Dim Arr As Variant, C As Variant, X%, Y%
[A10].CurrentRegion.ClearContents   '¸ê®Æ©ñ¸m¦ì¸m,²M°£¸ê®Æ(½Ð¦Û¦æ½Õ¾ã)
Arr = [a1].CurrentRegion
Set C = Nothing
For X = 1 To UBound(Arr)
   For Y = 1 To UBound(Arr, 2) - 1
      If Cells(X, Y) - Cells(X, Y + 1) = -1 Then  '§PÂ_¬O§_¬°³sÄò¼Æ­È
         If C Is Nothing Then
            Set C = Cells(X, Y).Resize(, 2)
         Else
            Set C = Union(C, Cells(X, Y).Resize(, 2))
         End If
      End If
   Next
   C.Copy [A10].Offset(X).Resize(, C.Count)    '¸ê®Æ©ñ¸m¦ì¸m(½Ð¦Û¦æ½Õ¾ã)
   Set C = Nothing
Next
End Sub

ML089

´ú¸Õ¼Æ¦r.zip (10.19 KB)

¤U¸ü¦¸¼Æ: 10

2021-3-30 14:31

´ú¸ÕÀÉ®×

ML089

¦^´_ 1# f00l01


¦]¬°A1:M5¸Ìªº¼Æ¦r¦³¨Ç¬O¤å¦r®æ¦¡¡A¨Ï¥ÎN(OFFSET())¤½¦¡®ÉµLªk§ì¥X¼Æ¦r¡A­×¥¿¬°¯Â¼Æ¦r¦p¤U
¤½¦¡A7 =--A1
½Æ»s¦Ü A7:M11

¿ï¾Ü O7:AA7
¿é¤J°}¦C¤½¦¡  = IF(MMULT({1,1},IFERROR(1/((A7:M7+{-1;1}) = N(OFFSET($A7,,COLUMN(A:M)+{-2;0}))),0)),A7:M7,"")
¥HCTRL+SHIFT+ENTER ¿é¤J¤½¦¡

¿ï¾Ü O7:AA7¡A¤U©Ô½Æ»s¤½¦¡

quickfixer

¦^´_ 1# f00l01

¤U¸ü (81.56 KB)

2021-3-29 15:47

­×¥¿¤@¤U,¥u¦C¥X³sÄò¼Æ¦r
    Sub test2()
    Columns("O:AA").ClearContents
    For r = 1 To 10
    cc = 1
    ccc = 0
    For c = 2 To 14
        If Cells(r, c) - Cells(r, c - 1) <> 1 Then
            s = ""
            For i = cc To c - 1
            s = s & "," & Cells(r, i)
            Next
            
            If UBound(Split(s, ",")) <> 1 Then
                ccc = ccc + 1
                Cells(r, ccc + 14) = s
            End If
            cc = c
        End If
    Next
    Next
End Sub