帖子: 79
主題: 19
精華: 0
積分: 148
點名: 0
作業系統: WINDOW7
軟體版本: EXCEL 2003
閱讀權限: 20
性別: 男
註冊時間: 2017-5-21
最後登錄: 2023-3-13

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2019-3-1 21:11 | 只看該作者

[發問] 判斷連續數字 VBA CODE 改善請指教

我的EXCEL VBA  主要用來把 0-9 的連續數字取出

現在的VBA CODE 比較累贅  0-9 就已經那麼多CODE了  假如0-50 那不就要50個條件了?
自己有想過用for loop 去進行加數方式  但不太會求指教

test.rar (92.63 KB)

樓主熱帖

luhpro

高中生 Rank: 3 Rank: 3

帖子: 835
主題: 6
精華: 0
積分: 915
點名: 16
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2024-11-14

2^#

發表於 2019-3-2 07:51 | 只看該作者

我的EXCEL VBA 主要用來把 0-9 的連續數字取出

現在的VBA CODE 比較累贅 0-9 就已經那麼多CODE了 ...
adrian_9832 發表於 2019-3-1 21:11

看不懂你的例子...
為甚麼一開始 210280 與 210281 不算連續數字?
接著 21032 21033 21034 也不算連續數字?
你需要敘述的更清楚一點,
哪些情形下不能列入連續數字處理喔.

若假設只要是連續數字都列出來,
那麼可以用下式:

Sub nn()
Dim lRow&, lVal&
lRow = 1
lVal = -99999
Do While Cells(lRow, 3) <> ""
With Cells(lRow, 3)
If .Value = lVal + 1 Then
.Interior.ColorIndex = 34
.Offset(, 2) = "abc"
If .Offset(-1, 2) <> "abc" Then
.Offset(-1).Interior.ColorIndex = 34
.Offset(-1, 2) = "abc"
End If
End If
lVal = .Value
End With
lRow = lRow + 1
Loop
End Sub

複製代碼

TOP

adrian_9832

中學生 Rank: 2

帖子: 79
主題: 19
精華: 0
積分: 148
點名: 0
作業系統: WINDOW7
軟體版本: EXCEL 2003
閱讀權限: 20
性別: 男
註冊時間: 2017-5-21
最後登錄: 2023-3-13

3^#

發表於 2019-3-2 19:55 | 只看該作者

因為問頭那個 210280 與 210281  只有0跟1 條件是要 0 ,1,2,3,4,5,6,7,8,9  當都齊才符合條件
只是想學習一下別人的法子是怎樣弄謝謝
以下是我的方法

Sub TE123ST()
Columns("e:e").Select
Selection.ClearContents
x = 1
Do Until Cells(x, 3) = ""
currentcell = Cells(x, 3)

If Right(currentcell, 1) = "0" Then
For i = 1 To 9
   nextcell = Cells(x + i, 3)
If Val(nextcell) <> Val(currentcell) + i Then
      Exit For
End If

If Val(nextcell) = Val(currentcell) + 9 Then
      Range(Cells(x, 5), Cells(x + 9, 5)).Value = "abc"
      Range(Cells(x, 3), Cells(x + 9, 3)).Select
      With Selection.Interior
         .Pattern = xlSolid
         If abc = 34 Then
            .PatternColorIndex = xlAutomatic
            .ColorIndex = 35
            abc = 35
            Else
            .ColorIndex = 34
            abc = 34
         End If
      End With
End If
Next i
End If
x = x + 1
Loop

End Sub

TOP

adrian_9832

中學生 Rank: 2

帖子: 79
主題: 19
精華: 0
積分: 148
點名: 0
作業系統: WINDOW7
軟體版本: EXCEL 2003
閱讀權限: 20
性別: 男
註冊時間: 2017-5-21
最後登錄: 2023-3-13

4^#

發表於 2019-3-2 19:57 | 只看該作者

回復 2# luhpro

我試用你的CODE 但ERROR 顯示型態不符合

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

5^#

發表於 2019-3-3 21:45 | 只看該作者

Sub Macro33()
Dim xR As Range, xH As Range, N%
[C:C].Interior.ColorIndex = 0
[E:E].ClearContents
For Each xR In Range([C1], [C65536].End(xlUp))
If Right(xR, 1) = "0" Then Set xH = xR: N = 0
If xR - xH = N Then N = N + 1 Else N = 0
If N = 10 Then
With Range(xR, xH): .Interior.ColorIndex = 34: .Offset(, 2) = "abc": End With
End If
Next
End Sub

TOP