[英]VBA: How can I keep only the date values from a string?
我有一个下面的字符串,想知道如何从中仅提取日期值并将其存储在单独的单元格中。
11AUG2016更改了gggqqq2i8yj 29SEP2016删除了tyijdg298 30SEP2016已添加,mkdjenb200 03OCT2016 zzxxddd4423 04OCT2016 jioi == ++-234jju 24OCT2016已更新tuiomahdkj 10JAN2017已更新zzzz T4123III 13JAN2017 20ajazz 2017年1月
对于A1中的数据,请尝试:
Sub marine()
Dim s As String, r As Range
s = Range("A1").Value
ary = Split(s, " ")
i = 2
For Each a In ary
Cells(i, 1).Value = a
If IsDate(Cells(i, 1).Value) Then
i = i + 1
End If
Next a
Set r = Cells(Rows.Count, 1).End(xlUp)
If IsDate(r.Value) Then Exit Sub
r.Clear
End Sub
该技术将候选对象放置在单元格中,然后测试其日期。 如果是日期,则将其保留,否则将被覆盖。
如果日期是唯一的“数字”,则可以使用SpecialCells()
Sub main()
Dim arr As Variant
arr = Split("11AUG2016 Changed gggqqq2i8yj 29SEP2016 Removed tyijdg298 30SEP2016 Added ,mkdjenb200 03OCT2016 zzxxddd4423 04OCT2016 jioi==++-234jju 24OCT2016 Updated tuiomahdkj 10JAN2017 Updated zzzz T4123III 13JAN2017 Updated jukalzzz123 20JAN2017 iiiwwwaazz678uuh", " ")
With Range("A1").Resize(UBound(arr) + 1)
.Value = Application.Transpose(arr)
.SpecialCells(xlCellTypeConstants, xlTextValues).Delete xlUp
End With
End Sub
如果字符串在单元格“ A1”中,则代码变为:
Sub main()
Dim arr As Variant
With Range("A1")
arr = Split(.Value, " ")
With .Resize(UBound(arr) + 1)
.Value = Application.Transpose(arr)
.SpecialCells(xlCellTypeConstants, xlTextValues).Delete xlUp
End With
End With
End Sub
以下方法保留了字符串格式-即日期以字符串形式写入(它使用简单的正则表达式)。 假设:您的字符串写在单元格A1中。
Sub ExtractDateFromString()
Dim s As String: s = Range("A1")
Dim re As Object: Set re = CreateObject("VBScript.RegExp")
re.Global = True
re.Pattern = "(\d{2}[A-Z]{3}20\d{2}\s)"
Set d = re.Execute(s)
r = 2
For Each x In d
Range("A" & r) = x
r = r + 1
Next
End Sub
试试下面的代码。
添加了一些错误处理,以防RegEx
通过,但其中的值不是有效日期。
Option Explicit
Sub ExtractDates()
Dim Reg1 As Object
Dim RegMatches As Variant
Dim Match As Variant
Dim i As Long
Dim dDay As Long
Dim dYear As Long
Dim dMon As String
Set Reg1 = CreateObject("VBScript.RegExp")
With Reg1
.Global = True
.IgnoreCase = True
.Pattern = "(\d{2}[a-zA-Z]{3}\d{4})" ' Match any set of 2 digits 3 alpha and 4 digits
End With
Set RegMatches = Reg1.Execute(Range("A1").Value)
i = 1
If RegMatches.Count >= 1 Then
For Each Match In RegMatches
dDay = Left(Match, 2)
dYear = Mid(Match, 6, 4)
dMon = Mid(Match, 3, 3)
On Error Resume Next
If Not IsError(DateValue(dDay & "-" & dMon & "-" & dYear)) Then
If Err.Number <> 0 Then
Else
Range("B" & i).Value = (Match)
Range("C" & i).Value = DateValue(dDay & "-" & dMon & "-" & dYear) ' <-- have the date (as date format) in column C
i = i + 1
End If
End If
On Error GoTo 0
Next Match
End If
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.