我想创建一个VBA宏,用时间格式(正则表达式)替换工作表中的所有单元格:
(1[0-2]|[1-9]):[0-5][0-9]:[0-5][0-9] [AP]M
使用单元格地址和工作表名称。我认为这个电话也是如此:
Cells.Replace What:="1:23:45 AM",
Replacement:="=cell(""filename"")&cell(""Address"")", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
但我希望我可以将“What:=
”参数作为注册表,或者至少限制为时间格式。
我该怎么做?
测试数据:以CSV格式保存以下内容:
00:00,04:27,00:36,04:31,00:00
00:00,00:00,04:18,01:07,10:06
00:00,00:00,00:00,00:00,00:00
最终宏将删除所有零次,并将其他时间替换为评估公式=cell("filename")&"!"&cell("address")
对上述输入文件采取行动的结果(我将纸张保存为XLSX):
[ A ] [ B ] [ C ] [ D ] [ E ]
[1] 'Sheet1!$B$1 'Sheet1!$C$1 'Sheet1!$D$1
[2] 'Sheet1!$C$2 'Sheet1!$D$2 'Sheet1!$E$2
[3]
为简洁起见,我删除了 =cell("filename")
函数返回的目录和文件名,尽管以上是我真正想要的。
答案 0 :(得分:5)
由于您正在尝试替换格式,我会根据格式进行替换。使用正则表达式,似乎你被迫处理底层数字。
我在XL 2003和2010中对此进行了测试:
Sub ReplaceByFormat()
With ActiveSheet.Cells
.Replace What:="", Replacement:="=cell(""filename"")&cell(""Address"")", _
SearchFormat:=True, _
ReplaceFormat:=False, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Application.FindFormat.NumberFormat = "h:mm AM/PM"
End With
End Sub
修改
首先,我在最后放置FindFormat时遇到了错误。它需要在开头(Doh)。
替换功能没有OR参数。下面,我刚刚重复了第二种格式的代码。
此代码假定日期都是常量。如果它们是公式,则可以使用vba中的查找和替换进行修复。如果它们是混合的,你需要稍微扩展一下代码:
Sub ReplaceByFormat()
With ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)
Application.FindFormat.NumberFormat = "h:mm AM/PM"
.Replace What:="", Replacement:="=cell(""filename"")&cell(""Address"")", _
SearchFormat:=True, _
ReplaceFormat:=False, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Application.FindFormat.NumberFormat = "m/d/yyyy"
.Replace What:="", Replacement:="=cell(""filename"")&cell(""Address"")", _
SearchFormat:=True, _
ReplaceFormat:=False, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
End With
End Sub
答案 1 :(得分:5)
我已将以前托管here的代码更新为
'00:00
(nb:最终,正则表达式过度,因为对于实际数据格式,0.0和1.0之间的值的单元格测试就足够了)
'Press Alt + F11 to open the Visual Basic Editor (VBE)
'From the Menu, choose Insert-Module.
'Paste the code into the right-hand code window.
'Press Alt + F11 to close the VBE
'In Xl2003 Goto Tools … Macro … Macros and double-click KillTime
Sub KillTime()
Dim rng1 As Range
Dim rngArea As Range
Dim lngRow As Long
Dim lngCol As Long
Dim lngCalc As Long
Dim objReg As Object
Dim strSht As String
Dim X()
On Error Resume Next
Set rng1 = Application.InputBox("Select range for the replacement of leading zeros", "User select", Selection.Address, , , , , 8)
If rng1 Is Nothing Then Exit Sub
On Error GoTo 0
strSht = ActiveWorkbook.Path & "\[" & ActiveWorkbook.Name & "]" & rng1.Parent.Name
'remove '00:00
rng1.Replace "00:00", vbNullString, xlWhole
'See Patrick Matthews excellent article on using Regular Expressions with VBA
Set objReg = CreateObject("vbscript.regexp")
objReg.Pattern = "^0\.\d+$"
'Speed up the code by turning off screenupdating and setting calculation to manual
'Disable any code events that may occur when writing to cells
With Application
lngCalc = .Calculation
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
'Test each area in the user selected range
'Non contiguous range areas are common when using SpecialCells to define specific cell types to work on
For Each rngArea In rng1.Areas
'The most common outcome is used for the True outcome to optimise code speed
If rngArea.Cells.Count > 1 Then
'If there is more than once cell then set the variant array to the dimensions of the range area
'Using Value2 provides a useful speed improvement over Value. On my testing it was 2% on blank cells, up to 10% on non-blanks
X = rngArea.Value2
For lngRow = 1 To rngArea.Rows.Count
For lngCol = 1 To rngArea.Columns.Count
If objReg.test(X(lngRow, lngCol)) Then X(lngRow, lngCol) = strSht & rngArea.Cells(1).Offset(lngRow - 1, lngCol - 1).Address(0, 0)
Next lngCol
Next lngRow
'Dump the updated array back over the initial range
rngArea.Value2 = X
Else
'caters for a single cell range area. No variant array required
If objReg.test(rngArea.Value) Then rngArea.Value = strSht & rngArea.Address(0, 0)
End If
Next rngArea
'cleanup the Application settings
With Application
.ScreenUpdating = True
.Calculation = lngCalc
.EnableEvents = True
End With
Set objReg = Nothing
End Sub
答案 2 :(得分:0)
首先,更好的模式是:
/[0-2]?[0-9]:[0-5][0-9]:[0-5][0-9] [A|P]M/
其次,没有任何特定于您的问题的实际代码将如此简单(适应您的方案,当然):
Set RegExp= CreateObject("VBScript.RegExp")
RegExp.Pattern = "[0-2]?[0-9]:[0-5][0-9]:[0-5][0-9] [A|P]M"
For i = ......
Expr = Format(ActiveSheet.Cells(i, 1).Value, ActiveSheet.Cells(i, 1).NumberFormat)
If RegExp.Test(Expr) Then Replace....
Next i
这样,VBA会在单元格出现时对其进行处理。
修改强>
关于模式也匹配" 29:00:00 | M" - 我不确定为什么" |"被认为是一个有效的字符,因为它意味着" OR"。如果您使用","也会发生同样的情况。无论如何,一个更好的肯定是:
/^(([0-1]?[0-9])|(2[0-4])):[0-5][0-9]:[0-5][0-9] [A|P]M$/
但最后,如果RegExp模式仅与时间值完全匹配并不重要,因为输入数据的格式化将通过Excel完成,这将预先验证单元格内容(如果键入" 29:00:00"它会将其转换为第二天的凌晨5点)。这是一个Excel解决方案,只能导致Excel解决方案,而不是全局解决方案。
从这个意义上说,使用正则表达式在Excel中甚至不常见 - RegExp是一个字符串测试器,没有语义含义评估,您可以使用其他方法在此上下文中验证输入。例如,您可以使用纯VBA执行相同的操作:
Function IsTime(rng As Range) As Boolean
Dim sValue As String
sValue = rng.Cells(1).Text
On Error Resume Next
IsTime = IsDate(TimeValue(sValue))
On Error GoTo 0
End Function
'Source: http://excel.tips.net/T003292_Checking_for_Time_Input.html