'原程式碼
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)"字串
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 時間: 2022-11-3 03:23
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作者: quickfixer 時間: 2022-11-3 05:42
多用了一個變數,修正如下
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作者: Andy2483 時間: 2022-11-3 12:43
