我已经查找了许多类似于我的问题但是有很大的不同。我试图在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
答案 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