如何将时间与时区分开并将时间设置为“yyyy-m hh：mm：ss”？

Question

如何将时间与时区分开，并将时间格式设为“yyyy-m hh：mm：ss”。查找“Time”列，创建其他两列：“Time *”和“Time_Zone”。 我修改了这段代码，但发生了一些错误，我把“On Error Resume Next”

For Each ws In Worksheets

For i = 1 To ws.Columns.Count
If ws.Cells(1, i) = "Hour" Then
 Set s = ws.Cells(1, i)
 LC = s.Column
 ws.Columns(LC + 1).Insert
 ws.Columns(LC).Copy
 ws.Cells(1, LC + 1).PasteSpecial Paste:=xlPasteValues
 ws.Cells(1, LC + 1).Value = "Time*"
 Exit For
 End If
 Next i


  For i = 1 To ws.Columns.Count
    If ws.Cells(1, i) = "Time*" Then
    ColLetr = Split(Cells(1, i).Address, "$")(1)
    y = i
    Exit For
   End If
 Next i
 If ColLetr <> "" Then 

 lastRow = ws.Cells(Rows.Count, y).End(xlUp).Row

 For Each cell In ws.Range(ColLetr & "3:" & ColLetr & lastRow)
 If InStr(cell.Value, "/") <> 0 Then
    cell.Value = RegexReplace(cell.Value, _
    "(\d{2})\/(\d{2})\/(\d{4})", "$3-$2-$1")
 End If

  cell.NumberFormat = "yyyy-mm-dd hh:mm:ss;@"

     If cell.Value <> "" Then
            cell.Value = Left(cell.Value, 19)               
      End If               
    Next
End If

For i = 1 To ws.Columns.Count
If ws.Cells(1, i) = "Hour" Then
Set s = ws.Cells(1, i)
LC = s.Column
ws.Columns(LC + 2).Insert
ws.Columns(LC).Copy
ws.Cells(1, LC + 2).PasteSpecial Paste:=xlPasteValues
ws.Cells(1, LC + 2).Value = "Time_Zone"
Exit For
End If
 Next i


For i = 1 To ws.Columns.Count
 If ws.Cells(1, i) = "Time_Zone" Then
    ColLetr = Split(Cells(1, i).Address, "$")(1)
    y = i
    Exit For
End If
Next i

If ColLetr <> "" Then
    lastRow = ws.Cells(Rows.Count, y).End(xlUp).Row

    For Each c In ws.Range(ColLetr & "3:" & ColLetr & lastRow)
     If c.Value <> "" Then

     On Error Resume Next

            c.Value = Right(c.Value, Len(c.Value) - 20)
     End If
    Next
End If

Next

Application.ScreenUpdating = False
End Sub


Function RegexReplace(ByVal text As String, _
                  ByVal replace_what As String, _
                  ByVal replace_with As String) As String

Application.ScreenUpdating = False
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")

RE.Pattern = replace_what
RE.Global = True
RegexReplace = RE.Replace(text, replace_with)
Application.ScreenUpdating = True

End Function

Answer 1

此代码适用于我：

Sub test()
    Dim ws As Worksheet
    Dim rngTime As Range

    Dim cell As Range
    Dim rngTarget As Range
    Dim formatedTime As String

    Application.ScreenUpdating = False

    For Each ws In Worksheets
        With ws
            Set rngTime = .Range("1:1").Find(What:="Time", MatchCase:=False, LookAt:=xlWhole)
            If Not rngTime Is Nothing Then
                rngTime.Offset(, 1).Resize(, 2).EntireColumn.Insert

                rngTime.Offset(, 1) = "Time*"
                rngTime.Offset(, 2) = "Time_Zone"

                lastrow = .Cells(.Rows.Count, rngTime.Column).End(xlUp).Row

                Set rngTarget = .Range(.Cells(3, rngTime.Column + 1), .Cells(lastrow, rngTime.Column + 1))
                rngTarget.NumberFormat = "yyyy-mm-dd hh:mm:ss;@"

                For Each cell In rngTarget
                    If InStr(cell.Offset(, -1), "/") <> 0 Then
                        formatedTime = RegexReplace(cell.Offset(, -1), _
                            "(\d{2})\/(\d{2})\/(\d{4})", "$3-$2-$1")
                        cell = Trim(Left(formatedTime, 19))
                        cell.Offset(, 1) = Trim(Mid(formatedTime, 20))
                    End If
                Next cell
            End If
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub


Function RegexReplace(ByVal text As String, _
                  ByVal replace_what As String, _
                  ByVal replace_with As String) As String

    Dim RE As Object
    Set RE = CreateObject("vbscript.regexp")

    RE.Pattern = replace_what
    RE.Global = True
    RegexReplace = RE.Replace(text, replace_with)

End Function

注意，在您的图片中，您在Time列中使用了E标题，但在您正在搜索Hour列中：{{1 }}。我在代码中使用If ws.Cells(1, i) = "Hour" Then标头，您可以在行Time中更改它。

<强>结果：