四位数中间如何补冒号

dhdhd

如果缺少冒号，自动在中间补冒号，冒号后面如果是一位数，补个0。谢谢

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j
  arr = [e1].CurrentRegion
  For i = 1 To UBound(arr, 1)
    For j = 1 To UBound(arr, 2)
      arr(i, j) = Replace(arr(i, j), ":", vbNullString)
      arr(i, j) = Left(arr(i, j), 2) & ":" & Format(Mid(arr(i, j), 3), "00")
    Next
  Next
  With [a1].Resize(UBound(arr, 1), UBound(arr, 2))
    .NumberFormatLocal = "@"
    .Value = arr
  End With
End Sub

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   With Worksheets("sheet1")
   
5.     r = .Cells(.Rows.Count, 5).End(xlUp).Row
   
6.     arr = .Range("e1:f" & r)
   
7.     For i = 1 To UBound(arr)
   
8.       For j = 1 To UBound(arr, 2)
   
9.         If InStr(arr(i, j), ":") = 0 Then
   
10.           arr(i, j) = Format(arr(i, j), "00:00")
    
11.         Else
    
12.           brr = Split(arr(i, j), ":")
    
13.           arr(i, j) = brr(0) & ":" & Format(brr(1), "00")
    
14.         End If
    
15.       Next
    
16.     Next
    
17.     .Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
    
18.   End With
    
19. End Sub
    

复制代码

chxw68

详见附件。

YZC51

一把小刀闯天下 发表于 2020-2-29 09:16
Option Explicit

Sub test()

学习老师的代码。谢谢老师！
Sub test()
  Dim arr, i, j
  arr = [e1].CurrentRegion
  For i = 1 To UBound(arr, 1)
    For j = 1 To UBound(arr, 2)
      arr(i, j) = Replace(arr(i, j), ":", vbNullString)
      arr(i, j) = Left(arr(i, j), 2) & Format(Mid(arr(i, j), 3), "\:00")
    Next
  Next
  With [a1].Resize(UBound(arr, 1), UBound(arr, 2))
    .NumberFormatLocal = "@"
    .Value = arr
  End With
End Sub

dhdhd

谢谢，太感谢老师了。