从另一个工作表中获取一个字符串并转换为日期格式

时间:2013-11-16 01:55:20

标签: vba

我已经查找了许多类似于我的问题但是有很大的不同。我试图在VBA excel中格式化的字符串没有任何点或连字符。我的字符串是从文件中的另一个工作表中解析出来的,它遍历工作表中的多行,因此每次它通过for循环运行时,它会在类似于此字符串的字符串中给出不同的日期:“11271998”。我需要用短日期格式或看起来像这样的“MM / DD / YYYY”。一旦采用这种格式,就需要将其放在另一个工作表中。我已经尝试了昏暗的日期,但它给了我一个错误。我想我需要创建一个函数并调用它,但我不知道如何使用mid或split来将字符串分开3次。请帮忙。  这是我的代码:

        Sub First()
  Dim i As Integer, j As Integer, Entries As Integer, Age As Integer
  Dim Name() As String, Lastname As String, Firstname As String, Group As String, Bdate As String
  Dim BSCswim(42)
  Dim LSC As String, Contact As String, Team As String, LastnameC() As String
  Dim Entrants() As swimmerData
  With Worksheets("BSC")
    Entries = .Range(.Range("A1"), .Range("A1").End(xlDown)).Count - 2
  End With
  ReDim Entrants(Entries)
  For i = 0 To Entries
    BSCswim(i) = Worksheets("BSC").Range("A1").Offset(i).Value
  Next i
  LSC = Mid(BSCswim(2), 12, 5)
  Team = Mid(BSCswim(2), 12, 30)
  For j = 3 To Entries Step 2
    Entrants(j).Fullname = Mid(BSCswim(j), 12, 28)
    Name = Split(Entrants(j).Fullname)
    Lastname = Name(0)
    Firstname = Name(1)
    LastnameC() = Split(Lastname, ",")
    Entrants(j).DOB = Mid(BSCswim(j), 56, 8)
    Entrants(j).Age = Mid(BSCswim(j), 64, 2)
    Age = Entrants(j).Age
    Group = AgeGroup(Age)
    Entrants(j).Gender = Mid(BSCswim(j), 66, 1)
    Entrants(j).event = Mid(BSCswim(j), 68, 4)
    Entrants(j).MemNum = Mid(BSCswim(j), 40, 12)
    Worksheets("Entries").Range("B2").Offset(j - 3).Value = Firstname
    Worksheets("Entries").Range("C2").Offset(j - 3).Value = LastnameC(0)
    Worksheets("Entries").Range("D2").Offset(j - 3).Value = Entrants(j).Fullname
    Worksheets("Entries").Range("E2").Offset(j - 3).Value = Entrants(j).Gender
    Worksheets("Entries").Range("F2").Offset(j - 3).Value = Entrants(j).DOB
    Worksheets("Entries").Range("G2").Offset(j - 3).Value = Group
    Worksheets("Entries").Range("H2").Offset(j - 3).Value = Age
    Worksheets("Entries").Range("I2").Offset(j - 3).Value = Entrants(j).MemNum
    Worksheets("Entries").Range("J2").Offset(j - 3).Value = Team
    Worksheets("Entries").Range("K2").Offset(j - 3).Value = LSC
Next j
End Sub
Function AgeGroup(ByRef Age As Integer)
Dim AgeG As String

   If Age <= 10 Then
          AgeG = "10 and Under"
     ElseIf Age = 11 Or Age = 12 Then
              AgeG = "11-12"
        ElseIf Age = 13 Or Age = 14 Then
                 AgeG = "13-14"
          ElseIf Age >= 15 And Age <= 18 Then
                    AgeG = "15-19"
                    ElseIf Age >= 19 And Age <= 24 Then
                      AgeG = "20-24"
                      ElseIf Age >= 25 And Age <= 29 Then
                         AgeG = "25-29"
                         ElseIf Age >= 30 And Age <= 34 Then
                            AgeG = "30-34"
                            ElseIf Age >= 35 And Age <= 39 Then
                                AgeG = "35-39"
                              ElseIf Age >= 40 And Age <= 44 Then
                                   AgeG = "40-44"
                                   ElseIf Age >= 45 And Age <= 49 Then
                                     AgeG = "45-49"
                                     ElseIf Age >= 50 And Age <= 54 Then
                                       AgeG = "50-54"
                                       ElseIf Age >= 55 And Age <= 59 Then
                                         AgeG = "55-59"
                                         ElseIf Age >= 60 And Age <= 64 Then
                                           AgeG = "60-64"
                                           Else
                                           AgeG = "65-69"
                                           End If

      AgeGroup = AgeG

    End Function

1 个答案:

答案 0 :(得分:0)

这会将日期保存到原始日期右侧的下一列。如果这样可以为您提供所需的格式,那么您只需将其保存在您想要的位置即可。

Private Sub CommandButton1_Click()
Call DateConverter
End Sub
Public Function DateConverter()
Dim rng As Range
Dim NewDate As Date

Set rng = Sheet1.Range("A1:A10")

For Each cell In rng
    NewDate = Mid(cell, 5, 2) & "/" & Right(cell, 2) & "/" & Left(cell, 4)
    cell.Offset(0, 1) = NewDate
Next cell

End Function