123
返回列表 上一主題 發帖

如何找出連續的數字

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-22 
11# 跳轉到 »
發表於 2021-3-31 18:22 | 只看該作者
P1//陣列公式(三鍵輸入)
=iferror(SMALL(IF(MMULT({1,1},COUNTIF($A1:$M1,$A1:$M1+{1;-1}))>0,--$A1:$M1),COLUMN(A1)),"")

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-22 
12#
發表於 2021-3-31 19:15 | 只看該作者
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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2024-10-30 
13#
發表於 2021-4-1 09:52 | 只看該作者
回復 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

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-22 
14#
發表於 2021-4-1 13:39 | 只看該作者
回復 13# samwang


A1 改成 1 試試~~

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2024-10-30 
15#
發表於 2021-4-1 17:28 | 只看該作者
回復 14# 准提部林


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

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2024-10-30 
16#
發表於 2021-4-1 21:22 | 只看該作者
感謝准大細心，又學到小技巧，更新如下，謝謝

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

f00l01

帖子
17 
主題
6 
精華
0 
積分
63 
點名
0  
作業系統
Windows 10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
註冊時間
2021-1-7 
最後登錄
2021-7-22 
17#
發表於 2021-4-22 18:01 | 只看該作者
謝謝大家，我再找時間好好了解每個解方。

再次感謝！！

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
18#
發表於 2022-10-31 10:50 | 只看該作者
本帖最後由 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

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
19#
發表於 2022-10-31 13:13 | 只看該作者
回復 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

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
20#
發表於 2022-10-31 13:59 | 只看該作者
字典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

        靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言，就如鑽石般珍貴；但對愚人來說，卻像是一把泥土，一點價值也沒有。
123
返回列表 上一主題