　暱稱: 厚臉皮的學生

帖子: 1425
主題: 40
精華: 0
積分: 1449
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-4-16

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2022-11-2 10:39 | 只看該作者

[發問] 如何修正 Or 的陳述不符合型態

各位前輩好
後學幫同學處理程式碼無法執行的問題,並幫忙心得註解!
請各位幫忙後學看一下修正跟註解是否有錯!謝謝!
原偵錯訊息:

修正後執行前:

執行結果:

'原程式碼
Option Explicit
Sub TEST_20221102_1()
Dim b&, xU As Range
For b = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
If Cells(1, b) = "NO 4(NI)" Or "HAS 4(I)" Then
   If xU Is Nothing Then Set xU = Cells(1, b) Else Set xU = Union(xU, Cells(1, b))
End If
Next b
If Not xU Is Nothing Then xU.EntireColumn.Delete
End Sub

'修正如下:
Sub TEST_20221102_2()
Dim b&, xU As Range, T
'↑宣告變數:b是長整數,xU是(物件:儲存格)
For b = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
'↑設順迴圈!從1 到第1列最右邊的欄數
If Cells(1, b) = "NO 4(NI)" Or Cells(1, b) = "HAS 4(I)" Then
'↑如果迴圈欄/第1列 = "NO 4(NI)"字串或迴圈欄/第1列 = "HAS 4(I)"字串

'Or 的使用不能像說話簡略!例如:
'如果你今天中午要外出買便當或陽春麵 ,請幫我買一份
'在程式碼裡:
'如果你今天中午要外出買便當或外出買陽春麵 ,請幫我買一份

   If xU Is Nothing Then
   '↑如果 xU沒有物件
      Set xU = Cells(1, b)
      '↑if條件成立!就令xU裝入(迴圈欄/第1列儲存格)
      Else
         Set xU = Union(xU, Cells(1, b))
           '↑如果if條件不成立(也就是說xU已經裝過儲存格了!
         '就把(迴圈欄/第1列儲存格)繼續放入 xU儲存格集裡
   End If
End If
Next b
If Not xU Is Nothing Then xU.EntireColumn.Delete
'↑如果xU儲存格集裡有物件儲存格!就把這些儲存格所在的欄刪除
End Sub

樓主熱帖

quickfixer

中學生 Rank: 2

帖子: 151
主題: 1
精華: 0
積分: 197
點名: 14
作業系統: windwos 7
軟體版本: 64bit
閱讀權限: 20
註冊時間: 2017-5-29
最後登錄: 2024-4-18

2^#

發表於 2022-11-3 03:23 | 只看該作者

本帖最後由 quickfixer 於 2022-11-3 03:24 編輯

回復 1# Andy2483

用regexp好像比較方便,速度還快一些

Sub test()
Dim Find_Num, reg As Object, brr, crr, i&, j&, s As Double, runtime As Double
runtime = Timer
Application.ScreenUpdating = False
brr = Range([操作表!B2], [操作表!B65536].End(3))
Set reg = CreateObject("VBScript.RegExp")
reg.Pattern = "\d+"
reg.Global = True
ReDim crr(1 To UBound(brr), 0)
For i = 1 To UBound(brr)
      s = 0
      Set Find_Num = reg.Execute(brr(i, 1))
      If Find_Num.Count > 0 Then
         For j = 0 To Find_Num.Count - 1
            s = s + Find_Num(j)
         Next j
      End If
      crr(i, 0) = s
Next i
Range("d2").Resize(UBound(brr), 1) = crr
Application.ScreenUpdating = True
Debug.Print Timer - runtime
Set reg = Nothing
End Sub

TOP

quickfixer

中學生 Rank: 2

帖子: 151
主題: 1
精華: 0
積分: 197
點名: 14
作業系統: windwos 7
軟體版本: 64bit
閱讀權限: 20
註冊時間: 2017-5-29
最後登錄: 2024-4-18

3^#

發表於 2022-11-3 05:42 | 只看該作者

回復 2# quickfixer

多用了一個變數,修正如下
Sub test()
Dim Find_Num, reg As Object, brr, crr, i&, j&, runtime As Double
runtime = Timer
Application.ScreenUpdating = False
brr = Range([操作表!B2], [操作表!B65536].End(3))
Set reg = CreateObject("VBScript.RegExp")
reg.Pattern = "\d+"
reg.Global = True
ReDim crr(1 To UBound(brr), 0)
For i = 1 To UBound(brr)
      Set Find_Num = reg.Execute(brr(i, 1))
      If Find_Num.Count > 0 Then
         For j = 0 To Find_Num.Count - 1
            crr(i, 0) = crr(i, 0) + Val(Find_Num(j))
         Next j
      End If
Next i
Range("d2").Resize(UBound(brr), 1) = crr
Application.ScreenUpdating = True
Debug.Print Timer - runtime
Set reg = Nothing
End Sub

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1425
主題: 40
精華: 0
積分: 1449
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-4-16

4^#

發表於 2022-11-3 12:43 | 只看該作者

回復 3# quickfixer

謝謝前輩指導!
初步知識查詢 CreateObject("VBScript.RegExp")是正則的語法,從沒學過
開始正則的學習! 補上範例檔

字串正則_數字總合.zip (341.02 KB)

前輩的程式執行時間比較短:

後學的程式執行時間比較長:

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1425
主題: 40
精華: 0
積分: 1449
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-4-16

5^#

發表於 2022-11-3 16:29 | 只看該作者

回復 3# quickfixer

謝謝前輩
以下研習心得註解如下!請前輩再指導!

Option Explicit
Sub test_quickfixer()
Dim Find_Num, reg As Object, brr, crr, i&, j&, runtime As Double
'↑宣告變數
runtime = Timer
Application.ScreenUpdating = False
brr = Range([操作表!B2], [操作表!B65536].End(3))
'↑令 brr是陣列!倒入操作表B欄的資料格值
Set reg = CreateObject("VBScript.RegExp")
'↑令 reg是正則
reg.Pattern = "\d+"
'↑令Pattern是數字串
reg.Global = True
'↑暫時不懂做什麼用的!先學著用!
ReDim crr(1 To UBound(brr), 0)
'↑宣告crr陣列範圍!縱向是1 到brr陣列縱向列數,橫向是 1欄
    '今天才知道二維空陣列單獨 1欄可以 0表示!以前只知道 1 TO 1,
', 0)表示陣列 0 TO 0 欄,因為唯一,所以可以以 0 陳述!UBound(crr, 2)=0
', 1)表示陣列 0 TO 1 欄!共兩欄! ,
', 1 TO 1)是表示不用第 0欄
'但是 brr = Range([操作表!B2], [操作表!B65536].End(3)) 是
'從brr(1,1)開始擺放!不是從brr(0,0)開始擺放!今天好像更清楚些!謝謝!
For i = 1 To UBound(brr)
'↑設外順迴圈從 1到brr陣列縱向列位數
      Set Find_Num = reg.Execute(brr(i, 1))
      '↑令 Find_Num是執行 brr陣列迴圈元素執行正則的結果
      If Find_Num.Count > 0 Then
      '↑如果正則的結果數量是>0 !
         For j = 0 To Find_Num.Count - 1
         '↑設內順迴圈從 0到正則的結果數量減 1
         '減1的原因是正則的結果是從序號 0開始排佈
            crr(i, 0) = crr(i, 0) + Val(Find_Num(j))
            '↑crr陣列放入字串正則取得的數字字串轉化為數值,
            '在內迴圈中累加
         Next j
      End If
Next i
Range("d2").Resize(UBound(brr) + 10, 2) = crr
'↑從[d2]擴展(brr陣列最大縱向列位數_列,1_欄)範圍儲存格,
'令上述範圍儲存格等於crr陣列!
'也就是要從crr陣列的最左上角資料對等[d2]位置帶入crr陣列值
'假設Resize()的範圍比crr陣列範圍小! 只取crr陣列的局部範圍
'假設Resize()的範圍比crr陣列範圍大! Resize()超出的局部範圍,
'橫向超出:會再重複陣列左上角資料開始帶入!
'縱向超出:會貼入 "#N/A" 字串
'這部分知識今天好像更清楚些!謝謝!
Application.ScreenUpdating = True
Debug.Print Timer - runtime
'↑後學都用Msgbox! 這即時運算視窗顯示不知道有什麼特別好處?
'今天知道迴圈裡的Msgbox要按很多次,沒效率!Debug.Print 直接顯示
'謝謝前輩
Set reg = Nothing
End Sub

TOP

Andy2483