在VBA中从文本格式到date格式的date
我想改变date从文本格式到date格式（自定义）dd / mm / yyyy hh：mm。 我一直在阅读网站内的所有类似的问题，但似乎没有为我工作。 即使我应用更改，date保持文本格式。 有没有办法在VBA中使用Date函数？ 或者一般来说，关于如何才能最终使其工作的任何想法。 我的date是来自名为“TMS”的Excel工作表的vlookup，它们是文本格式的。 目标表是“Tracker”。 date从网站导入到“TMS”表，所以我必须在Excel中自动执行格式的更改。 我的代码在下面提供。 非常感激！！
下面的代码是固定的代码，date格式的工作，但它不会运行每一行的循环，而只是复制粘贴到其他行的第一行的值。 换句话说，它对于第一行是完美的，但对另一个却不行。
Sub Tracker() Sheets("TMS").Select lastrow = Range("B" & Rows.Count).End(xlUp).Row With Range("G2:G" & lastrow) If Not IsEmpty(Range("G2:G" & lastrow)) Then .value = .Parent.Evaluate("DATE(MID(" & .Address & ",7,4),MID(" & .Address & ",4,2),LEFT(" & .Address & ",2))+RIGHT(" & .Address & ",4)") End If End With Sheets("Tracker").Select lastrow = Range("B" & Rows.Count).End(xlUp).Row With Range("AG2:AG" & lastrow) .Formula = "=VLOOKUP(B2,TMS!B:G,6,FALSE)" .value = .value End With End Sub 只需添加到您的With Range("G2:G" & lastrow)部分：
.Value = .Parent.Evaluate("DATE(MID(" & .Address & ",7,4),MID(" & .Address & ",4,2),LEFT(" & .Address & ",2))+RIGHT(" & .Address & ",4)")
这应该改变所有的string数值一步:)
编辑
由于Evaluate不希望以这种方式返回数组，我们只需通过INDEX强制它：
.Value = .Parent.Evaluate("INDEX(DATE(MID(" & .Address & ",7,4),MID(" & .Address & ",4,2),LEFT(" & .Address & ",2))+RIGHT(" & .Address & ",4),)")
在上面的图片中，我已经说明了用于从文本转换为各种组件的公式，然后返回到包括时间在内的date序列。 F2的格式被设置为自定义格式以正确显示。
我不知道你的工作表是如何组织的，但考虑到date被导入到Sheets("TMS").Range("G2:G" & lastrow) ，并且只能使用.NumberFormat = "mm/dd/yyyy hh:mm"那么你需要摆脱完整的文本并将其粘贴为date。
你也应该避免select纸张。 你的代码应该看起来类似于这个。 如果我猜错了，请纠正这些部分。
Sub Tracker() Dim lastrow As Long Dim arr() As Date With Sheets("TMS") lastrow = .Range("B" & .Rows.Count).End(xlUp).Row ReDim arr(lastrow) As Date For i = 2 To lastrow arr(i) = .Range("G" & i).Value Next i .Range("G2:G" & lastrow).Delete For i = 2 To lastrow .Range("G" & i) = arr(i) Next i .Range("G2:G" & lastrow).NumberFormat = "mm/dd/yyyy hh:mm" End With With Sheets("Tracker") lastrow = .Range("B" & .Rows.Count).End(xlUp).Row With .Range("AG2:AG" & lastrow) .Formula = "=VLOOKUP(B2,TMS!B:G,6,FALSE)" .NumberFormat = "mm/dd/yyyy hh:mm" End With End With End Sub
试试这个代码。
Sub Tracker() Dim vDB, vT, vD Dim i As Long With Sheets("TMS") lastrow = .Range("B" & Rows.Count).End(xlUp).Row With .Range("G2:G" & lastrow) vDB = .Value If IsDate(vDB(1, 1)) Then Else For i = 1 To UBound(vDB, 1) vT = Split(vDB(i, 1), " ") vD = Split(vT(0), "/") vDB(i, 1) = DateSerial(vD(2), vD(1), vD(0)) + Val(Trim(vT(1))) Next i End If .Value = vDB .NumberFormat = "mm/dd/yyyy hh:mm" End With End With With Sheets("Tracker") lastrow = .Range("B" & Rows.Count).End(xlUp).Row With .Range("AG2:AG" & lastrow) .Formula = "=VLOOKUP(B2,TMS!B:G,6,FALSE)" .NumberFormat = "mm/dd/yyyy hh:mm" .Value = .Value End With End With End Sub