Question

如何创建一个自动检测天，小时，分钟和秒的公式或vba，并将其转换为右[h]:mm:ss一次粘贴到excel？我需要处理一些数据，它们采用以下格式（字符串）：

134 days 10 hrs 41 mins 23 secs
109 days 40 mins 37 secs
67 days 10 hrs 37 secs
33 days 3 hrs 7 mins 21 secs
21 days 14 hrs 7 mins 46 secs
15 days 7 hrs 19 mins
15 days 3 hrs 45 mins 59 secs
15 days 7 mins 35 secs
13 days 2 hrs 56 mins 57 secs
18 hrs 45 mins 33 secs

Answer 1

使用数组的快速VBA方法

在这里，您可以找到使用数组和辅助函数的快速VBA方法来计算日期单位hrs，min和secs的转换。

警告下面的第一个示例假设一个固定的字符串结构，其中包含每个单元部分。对于省略天，小时或分钟的情况，您必须修改拆分逻辑。

请参阅案例（2）中的编辑，了解如何做到这一点。

案例（1）固定结构天数+小时+分钟+秒

Option Explicit             ' declaration head of code module         

Sub s2date()
' declare your variables
  Dim myUnits() As Long     ' array, ~~> redim below
  ReDim myUnits(0 To 3)     ' redim to ZERO based 1-dim array
  Dim v                     ' variant, receives one-based 2-dim data field contents
  Dim s         As Variant  ' temporary split value
  Dim i         As Long     ' counter array items
  Dim ii        As Integer  ' counter tokens
  Dim n         As Long     ' counter last row number
  Dim ws As Worksheet
  Set ws = ThisWorkbook.Worksheets("MySheetName") ' << change to sheet where you store your sheet names
' get last row number
  n = ws.Range("B" & ws.Rows.Count).End(xlUp).row
' create one based 2-dim datafield array from your sheetname list
' (assuming start in cell B2, ending in row n, omitting title row)
  v = ws.Range("B2:B" & n)
  ws.Range("C:C").NumberFormat = "[h]:mm:ss"
' convert values hold in array
  For i = 1 To n - 1     ' loop through array items from 1 to n minus 1 title row)
      s = v(i, 1)        ' get your date string, e.g. "134 days 10 hrs ..."
      s = Split(s, "s ") ' split it at last unit characters "s "
      For ii = LBound(s) To UBound(s)  ' parse each single token
          myUnits(ii) = Val(Trim(Split(s(ii) & " ", " ")(0))) '
      Next ii
    ' convert units to date via helper function
      v(i, 1) = calcDate(myUnits)
  Next i
' write back dates in datafield array v to column C:C
  ws.Range("C2:C" & n) = v
End Sub

辅助功能

Function calcDate(ar) As Double
' Purpose: Helper function to convert date units (long) to date, called by s2date()
  Const days = 0:    Const hrs = 1:    Const mins = 2:    Const secs = 3
' return date -- assuming to omit days count
  calcDate = ar(hrs) / 24# + ar(mins) / (24# * 60) + ar(secs) / (24# * 60 * 60)
End Function

=====编辑=======

下面的改编代码示例允许使用或省略列出的每个解析字符串“days”，“hrs”，“mins”或“secs”。

警告：使用“天”作为复数，即使只有1天，也可以考虑Replace()。

案例（2）灵活的结构日|小时|分钟|秒（已编辑）

Option Explicit     ' declaration head of code module
' declare date/time constants
  Const days = 0:    Const hrs = 1:    Const mins = 2:    Const secs = 3

Sub parseDate()             ' << changed procedure name, cf. comment
' declare your variables
  Dim myUnits() As Long     ' array, ~~> redim below
  ReDim myUnits(0 To 3)     ' redim to ZERO based 1-dim array
  Dim v                     ' variant, receives one-based 2-dim data field contents
  Dim s, term, temp         ' << variant, temporary split values
  Dim i         As Long     ' counter of array items
  Dim ii        As Integer  ' counter of parsed tokens
  Dim n         As Long     ' counter last row number
  Dim ws As Worksheet
  Set ws = ThisWorkbook.Worksheets("MySheetName") ' << change to sheet where you store your sheet names
' get last row number
  n = ws.Range("B" & ws.Rows.Count).End(xlUp).row
' create one based 2-dim datafield array from your sheetname list
' (assuming start in cell B2, ending in row n, omitting title row)
  v = ws.Range("B2:B" & n)
  ws.Range("C:C").NumberFormat = "[h]:mm:ss"
' convert values hold in array
  For i = 1 To n - 1     ' loop through array items from 1 to n minus 1 title row)

      s = v(i, 1)        ' get your date string, e.g. "134 days 10 hrs ..."
      s = Replace(s, vbLf, "") ' EDIT/cf.comment: remove possible line feeds
      s = Split(s & " 0 s 0 s ", "s ")                       ' split it at last unit characters "s "
      For ii = days To secs: myUnits(ii) = 0: Next ii        ' clear values
      For ii = days To secs  ' parse each single term
          term = Trim(Split(s(ii) & String(4, " "), " ")(1)) ' 2nd split delimiter is a blank character
          temp = Val(Trim(Split(s(ii) & String(4, " "), " ")(0)))
          If getTerm(ii) = term Then
             myUnits(ii) = temp
          Else
             If term = "hr" Then myUnits(hrs) = temp
             If term = "min" Then myUnits(mins) = temp
             If term = "sec" Then myUnits(secs) = temp
          End If
                    Debug.Print i + 1 & "/getTerm(" & ii & ") " & getTerm(ii) & " = " & term & " => " & _
                          "hrs=" & myUnits(1) & ", mins=" & myUnits(2) & ", secs=" & myUnits(3)
      Next ii
    ' convert units to date via helper function
      v(i, 1) = calcDate(myUnits)
  Next i
' write back dates in datafield array v to column C:C
  ws.Range("C2:C" & n) = v
End Sub

帮助程序功能

Function calcDate(ar) As Double
' Purpose: Helper function to convert date units (long) to date, called by s2date()
' return date -- assuming to omit days count
  calcDate = ar(hrs) / 24# + ar(mins) / (24# * 60) + ar(secs) / (24# * 60 * 60)
End Function

Function getTerm(n As Integer) As String
' Purpose: Helper function to get abbreviation string (without plural s)
  Dim abbrev:  abbrev = Array("day", "hr", "min", "sec")  ' << added abbreviation string
  If n > 3 Then Exit Function
  getTerm = abbrev(n)     ' nth term = e.g. "day"                              '
End Function

转换天数hrs mins secs字符串为[h]：mm：ss in excel

1 个答案: