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

Vba 从另一个工作表中提取字符串并转换为日期格式,vba,Vba,我查了很多与我类似的问题,但有很大的不同。我试图在VBA excel中格式化的字符串没有任何点或连字符。我的字符串是从文件中的另一个工作表中解析出来的,它在工作表中遍历多行,因此每次遍历for循环时,它都会在一个类似于“11271998”的字符串中给出一个不同的日期。我需要把它放在短日期格式或像这样的“MM/DD/YYYY”。一旦采用这种格式,就需要将其放入另一个工作表中。我试过用dim作为日期,但它给了我一个错误。我想我需要创建一个函数并调用它,但我不确定如何使用mid或split将字符串分隔

我查了很多与我类似的问题,但有很大的不同。我试图在VBA excel中格式化的字符串没有任何点或连字符。我的字符串是从文件中的另一个工作表中解析出来的,它在工作表中遍历多行,因此每次遍历for循环时,它都会在一个类似于“11271998”的字符串中给出一个不同的日期。我需要把它放在短日期格式或像这样的“MM/DD/YYYY”。一旦采用这种格式,就需要将其放入另一个工作表中。我试过用dim作为日期,但它给了我一个错误。我想我需要创建一个函数并调用它,但我不确定如何使用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
Sub-First()
Dim i为整数,j为整数,条目为整数,年龄为整数
Dim Name()作为字符串,Lastname作为字符串,Firstname作为字符串,Group作为字符串,Bdate作为字符串
游泳(42)
Dim LSC作为字符串、Contact作为字符串、Team作为字符串、LastnameC()作为字符串
Dim Entrants()作为数据
带工作表(“BSC”)
条目=.Range(.Range(“A1”),.Range(“A1”).End(xlDown))。计数-2
以
重播参赛者(参赛作品)
对于i=0的条目
BSC(i)=工作表(“BSC”).范围(“A1”).偏移量(i).值
接下来我
LSC=Mid(2,12,5)
团队=中级(2、12、30)
对于j=3,执行步骤2
参赛者(j)。全名=中级(j),12,28)
Name=Split(参赛者(j).Fullname)
Lastname=Name(0)
Firstname=Name(1)
LastnameC()=拆分(Lastname,“”)
参赛者(j)。DOB=Mid(j),56,8)
参赛者(j)。年龄=中等(j),64,2)
年龄=参赛者(j)。年龄
组=年龄组(年龄)
参赛者(j)。性别=中等(j),66,1)
参赛者(j)。项目=中级(j),68,4)
参赛者人数(j),MemNum=Mid(j,40,12)
工作表(“条目”).范围(“B2”).偏移量(j-3).值=名字
工作表(“条目”)。范围(“C2”)。偏移量(j-3)。值=LastnameC(0)
工作表(“条目”)。范围(“D2”)。偏移量(j-3)。值=参赛者(j)。全名
工作表(“条目”)。范围(“E2”)。偏移量(j-3)。值=参赛者(j)。性别
工作表(“条目”)。范围(“F2”)。偏移量(j-3)。值=参赛者(j)。DOB
工作表(“条目”).范围(“G2”).偏移量(j-3).值=组
工作表(“条目”)。范围(“H2”)。偏移量(j-3)。值=年龄
工作表(“条目”).Range(“I2”).Offset(j-3).Value=参赛者(j).MemNum
工作表(“条目”)。范围(“J2”)。偏移量(j-3)。值=团队
工作表(“条目”)。范围(“K2”)。偏移量(j-3)。值=LSC
下一个j
端接头
函数年龄组(ByRef年龄为整数)
作为字符串的Dim AgeG

如果年龄=15,年龄=19,年龄=25,年龄=30,年龄=35,年龄=40,年龄=45,年龄=50,年龄=55,年龄=60,年龄这将把日期保存到原始日期右侧的下一列。如果这为您提供了所需的格式,那么您只需将其保存在所需的位置

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

你能把你目前掌握的密码发出去吗?