帖子: 712
主題: 281
精華: 0
積分: 1019
點名: 0
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2011-6-30
最後登錄: 2025-5-22

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2022-1-29 16:31 | 只看該作者

[發問] 如何判斷儲存格中有冒號？

判斷儲存格是否有冒號.rar (6.49 KB)

詳如附件，在B欄手動產生後，A、C欄自動產生(構思如下)

For i = 2 to
if cells(i,2) 有冒號 Then
cells(i,1) = ROW()-1
Na = cells(i,2)
else
cells(i,3) = Na
Next

但是查找了網路只有找到Set cell = Range("B1:B2000").FIND(":", LookIn:=xlValues, LookAt:=xlPart)
套用到迴圈不知是否有類似的寫法？還請前輩們告知，感激不盡！

樓主熱帖

singo1232001

　暱稱: 熱狗慶

中學生 Rank: 2

帖子: 354
主題: 5
精華: 0
積分: 387
點名: 0
作業系統: windows7
軟體版本: vba,vb,excel2007
閱讀權限: 20
性別: 男
註冊時間: 2017-1-8
最後登錄: 2024-8-2

論壇榮譽勳章論壇贊助勳章

2^#

發表於 2022-1-29 20:37 | 只看該作者

回復 1# av8d

可能有bug 幫忙測看看

判斷儲存格是否有冒號.zip (15.96 KB)

TOP

ikboy

中學生 Rank: 2

帖子: 262
主題: 8
精華: 0
積分: 280
點名: 0
作業系統: xp
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2015-8-11
最後登錄: 2025-3-24

2016猴年全勤獎章

3^#

發表於 2022-1-29 21:04 | 只看該作者

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i&, j&
If Not Target.Column = 2 Or Len(Target.Value) = 0 Then Exit Sub
i = Target.Row
If i < 2 Or Right(Target.Value, 1) = ":" Then Exit Sub
Cells(i, 1) = Application.Max(Range("a1:a" & i)) + 1
j = i
Do
j = j - 1
Loop Until Right(Cells(j, 2), 1) = ":"
Cells(i, 3).Value = Left(Cells(j, 2).Value, Len(Cells(j, 2).Value) - 1)
End Sub

複製代碼

zz.zip (13.21 KB)

TOP

singo1232001

　暱稱: 熱狗慶

中學生 Rank: 2

帖子: 354
主題: 5
精華: 0
積分: 387
點名: 0
作業系統: windows7
軟體版本: vba,vb,excel2007
閱讀權限: 20
性別: 男
註冊時間: 2017-1-8
最後登錄: 2024-8-2

論壇榮譽勳章論壇贊助勳章

4^#

發表於 2022-1-29 23:13 | 只看該作者

本帖最後由 singo1232001 於 2022-1-29 23:21 編輯

回復 1# av8d

內有3份檔案  都有修改過
大致說明一下所有控制
1. 開檔就會觸發不會出錯
2. 範圍選取刪除不會出錯
3. [a1:d1] 自動會增加標籤
4. [a2] 會自動放1  A欄序號會自動增加
5.  C欄會自動搜尋上一個最近的冒號名稱

(v1)
1.  有冒號的右邊C欄會強制呈現空白

(v2)會比較特別一點
1. 有冒號的右邊C欄會強制呈現空白
2. b欄若中間有空白位資料斷裂就不觸發的功能
3. b欄選擇框若經過有自動更新功能通常是怕有上面資料需要修改

(v3)
1.  有冒號的右邊C欄會強制呈現空白
2.  b欄若中間有空白位資料斷裂  一樣會觸發的功能
3.  b欄選擇框若經過有自動更新功能通常是怕有上面資料需要修改

最後不一定能在使用上完全剛好滿足您的需求
這兩份檔案頂多是盡量展示功能
若有功能想要提升或消除再請回報

判斷儲存格是否有冒號.zip (66.57 KB)

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

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

5^#

發表於 2022-1-30 09:14 | 只看該作者

Sub TEST_A1()
Dim Arr, i&, T$, TT$, SS$
Arr = Range([a1], [b65536].End(xlUp))
For i = 2 To UBound(Arr)
T = Arr(i, 2): SS = TT
If Right(T, 1) = ":" Then TT = Replace(T, ":", ""): SS = ""
Arr(i - 1, 1) = SS
Next i
[c2].Resize(UBound(Arr) - 1) = Arr
End Sub

TOP

hcm19522