返回列表 上一主題 發帖

如何找出連續的數字

P1//陣列公式(三鍵輸入)
=iferror(SMALL(IF(MMULT({1,1},COUNTIF($A1:$M1,$A1:$M1+{1;-1}))>0,--$A1:$M1),COLUMN(A1)),"")

TOP

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

TOP

回復 1# f00l01

全部連續值顯示在同一格儲存格如照片,請測試看看,謝謝。
Sub tt2()
Dim Arr, TT, T%, T1%, L%, i&, j&
[o1].CurrentRegion = ""
Arr = [a1].CurrentRegion
For i = 1 To UBound(Arr)
    L = 0
    For j = 1 To UBound(Arr, 2)
        If j < UBound(Arr, 2) Then T1 = Arr(i, j + 1)
        T = Arr(i, j)
        If T1 - T = 1 Or T - L = 1 Then
            TT = TT & "," & Arr(i, j): L = T
        End If
    Next
    Arr(i, 1) = Mid(TT, 2): TT = ""
Next
Range("o1").Resize(UBound(Arr)) = Arr
End Sub

擷取.PNG (14.73 KB)

擷取.PNG

TOP

回復 13# samwang


A1 改成 1 試試~~

TOP

回復 14# 准提部林


感謝准大指導,真的有問題,有空時再來想看看如何解,感謝。

TOP

感謝准大細心,又學到小技巧,更新如下,謝謝

Sub tt3()
Dim Arr, TT, T%, T1%, L&, i&, j&
[o1].CurrentRegion = ""
Arr = [a1].CurrentRegion
For i = 1 To UBound(Arr)
    L = 9 ^ 9
    For j = 1 To UBound(Arr, 2)
        If j < UBound(Arr, 2) Then T1 = Arr(i, j + 1)
        T = Arr(i, j)
        If T1 - T = 1 Or T - L = 1 Then
            TT = TT & "," & T: L = T
        End If
    Next
    Arr(i, 1) = Mid(TT, 2): TT = ""
Next
Range("o1").Resize(UBound(Arr)) = Arr
End Sub

TOP

謝謝大家,我再找時間好好了解每個解方。

再次感謝!!

TOP

本帖最後由 Andy2483 於 2022-10-31 10:53 編輯

回復 12# 准提部林


    '謝謝前輩
'這帖學到
'1.資料型態:長整數的最小值 是-2147483648
'2.知道什麼是數字溢位
'3.不能只看問題的正面!負面的也要考慮!畢竟主角是數字
'4.防誤判是很重要的事!
'5.很多知識與學問是練習才能體會的!
'6.天助自助人助
請前輩再指導!謝謝
Option Explicit
Sub TEST()
Dim Arr, V&, U1&, U2&, i&, j%, T$
'↑宣告變數
Arr = Range([A1], [m65536].End(xlUp))
'↑令Arr是陣列!倒入[A1]到M欄最後一個有內容儲存格,擴展到方正最小區域儲存格值
For i = 1 To UBound(Arr)
'↑設外順迴圈!從1到Arr陣列縱向最後一列數
    V = -9 ^ 9
    '↑令V數字是9的9次方負值=(9 ^ 9)*(-1)= -387420489
    '查詢了VBA 的資料型態: V& 長整數的最小值 是-2147483648 !
    '為什麼不用它當V值??  因為後方程序會讓變數溢位(比 -2147483648 更小)
    '因為V的初始值是0 如果一開始沒有給V一個第一使用值
    '後方的程序會誤判[A1]=1 時連續

    For j = 1 To UBound(Arr, 2)
    '↑設內順迴圈!從1到Arr陣列橫向最後一欄數
        U1 = Arr(i, j)
        '↑令U1是Arr陣列內外迴圈的主角(數字)
        U2 = U1
        '↑U2 = U1是為了 消除U2在前次迴圈中殘餘數字(U2初始值是0)
        If j < UBound(Arr, 2) Then
        '↑如果j這內迴圈數小於 Arr陣列橫向最後一欄數
           U2 = Arr(i, j + 1)
           'U2就變心成為 U1主角右邊格的那個值(數字)
        End If
        If U1 - V = 1 Or U2 - U1 = 1 Then
        '↑如果主角U1 - V =1,是要判斷負數值的連續
        '或 變心U2的-主角U1=1

           T = T & "," & U1
           '↑令T =T字串連接 "," 符號 ,再連接主角U1
           V = U1
           '↑令V數字是主角U1值
        End If
    Next j
    Arr(i, 1) = Mid(T, 2)
    '↑令外迴圈Arr陣列的第一欄取內迴圈 T字串裡的第2個字開始(含自己)的全部字串
    '↑Mid(T, 2)後學今天才知道可以這樣陳述!以前都用Mid(T, 2,99)
    '因為第一個字是 "," 符號

    T = ""
    '↑令清空 T字串
Next i
[O1].Resize(UBound(Arr)) = Arr
'↑Arr陣列 從[O1]開始貼入 Arr陣列縱向最後一列數,只貼入1欄位資料
'同[O1].Resize(UBound(Arr), 1) = Arr,1可以省略
End Sub

執行前:


執行結果:

TOP

回復 12# 准提部林


    謝謝前輩
此帖後學用陣列與字典練習心得如下
請前輩再指導!謝謝
1.能不必用字典就不要刻意使用! 資料倒進倒出都需要時間
2.用變數直接傳遞訊息較快

前輩的程式碼執行10000列的時間:


後學的程式碼執行10000列的時間:


Option Explicit
Sub TEST_2()
Dim Arr, i&, j&, T, V, Y, U1, U2, S
S = Timer
Set Y = CreateObject("Scripting.Dictionary")
Arr = Range([A1], [m65536].End(xlUp))
[O:O].ClearContents
For i = 1 To UBound(Arr)
   V = -9 ^ 9
   For j = 1 To UBound(Arr, 2)
      If j < UBound(Arr, 2) Then
         U1 = Arr(i, j): U2 = Arr(i, j + 1)
         If U1 * U2 >= 0 Then
            Y(U1) = IIf(Y(U1) <> 1, Abs((U2) - (U1)), Y(U1))
            Y(U2) = IIf(Y(U2) <> 1, Abs((U2) - (U1)), Y(U1))
         End If
      End If
   Next
   For Each T In Y.KEYS
      If Y(T) <> 1 Then
         Y.Remove (T)
      End If
   Next
   Arr(i, 1) = Join(Application.Transpose(Application.Transpose(Y.KEYS)), ",")
   Y.RemoveAll
Next
[O1].Resize(UBound(Arr)) = Arr
MsgBox Timer - S & "秒"
End Sub

TOP

字典key轉置的方式改成迴圈直接寫入陣列少!稍好!


Option Explicit
Sub TEST_3()
Dim Arr, i&, j&, T, V, Y, U1, U2, S
S = Timer
Set Y = CreateObject("Scripting.Dictionary")
Arr = Range([A1], [m65536].End(xlUp))
[O:O].ClearContents
For i = 1 To UBound(Arr)
   V = -9 ^ 9
   For j = 1 To UBound(Arr, 2)
      If j < UBound(Arr, 2) Then
         U1 = Arr(i, j): U2 = Arr(i, j + 1)
         If U1 * U2 >= 0 Then
            Y(U1) = IIf(Y(U1) <> 1, Abs((U2) - (U1)), Y(U1))
            Y(U2) = IIf(Y(U2) <> 1, Abs((U2) - (U1)), Y(U1))
         End If
      End If
   Next
   Arr(i, 1) = ""
   For Each T In Y.KEYS
      If Y(T) <> 1 Then
         Y.Remove (T)
         Else
            Arr(i, 1) = Arr(i, 1) & "," & T
      End If
   Next
   Arr(i, 1) = Mid(Arr(i, 1), 2)
   Y.RemoveAll
Next
[O1].Resize(UBound(Arr)) = Arr
MsgBox Timer - S & "秒"
End Sub

TOP

        靜思自在 : 有多少力量就做多少事,不要心存等待,等待才會落空。
返回列表 上一主題