Excel，VB – 将8位数字的date序列化为mm / dd / yy

问题

我想在一个数组中将一个8位数字转换成一个date。 条目的示例是12282009或12202007.该字段中还有其他格式错误的条目，包括以stringformsinput的date。 我希望8位数字的格式分别为12/28/09或12/20/07。 我在下面的第三行到最后一行不断出现types不匹配错误。 我该怎么做呢？？

码

Dim del() ReDim del(1 To importwsRowCount, 1 To 1) del = Range("AH1:AH" & importwsRowCount).Value Dim delChars As Long Dim delType As String For i = LBound(del, 1) To UBound(del, 1) delChars = Len(del(i, 1)) 'Determine length of entry If IsNumeric(del(i, 1)) = True Then 'Determine datatype of entry delType = "Numeric" del(i, 1) = Abs(del(i, 1)) Else delType = "String" del(i, 1) = UCase(del(i, 1)) End If If delType = "Numeric" Then If delChars = 8 Then del(i, 1) = DateSerial((Right(del(i, 1), 4)), (Left(del(i, 1), 2)), (Mid(del(i, 1), 3, 2))) '<-- TYPE MISMATCH ERROR End If End If 

入学模板

九月 25，20 （不要年，不要删！）
9月 （无年，无用，删除）
N / A （垃圾！已删除）
LONG TIME AG （白痴认为这是一个好主意，请删除。）
200年6月30日 （显然这个字段只能保存12个字符，删除。）
CHARGED OFF （无用，删除）
94天 （取所有空格前的字符，并从包含订单date的其他字段中减去以获得拖欠date。）
94 DPD （在某些人的DPD中，聪明的头脑代表“过去的日子”，我相信，和上面一样）
（不知道附加的号码是什么，请在空格之前把所有字符转换。）
无效 （删除）
空白 （什么也不做）
4/2/4/09 （格式不正确，删除。）
1/1/009 （同上）
12282009 （使用嵌套的左和右和与之间的/ CONCATENATE）
9202011 （添加前导零，然后与上面相同。）
92410 （添加前导零，这将转换为09/24/10）
41261 （自1899年12月31日起，这将转换为12/08/12）
1023 （违约天数，从订单date扣除以得到拖欠date。）
452 （同上）
12 （同上）
1432.84 （货币价值，被低智商的奴隶误入了）删除。

Answer 1

您可以使用这个较短的代码来将数组元素replace为格式化date

1. 它将循环内的testing数量减less到两个IF 。 如果首先运行数字testing – 对于不是8个字符的string，则没有必要运行更长的len inttesting
2. string函数Left$ ， Mid$等比他们的变种兄弟Left ， Mid等等更快

我已经在下面的代码中为您的importwsRowCountvariables进行了replace

更新的代码来处理和转储结果，现在根据barrowc注释处理stringtesting和非符合规范

下面的代码将新的date放到第二个数组中，跳过无效的date。第二个数组然后被放在`AI`处

 Sub ReCut2() Dim del() Dim X() Dim lngCnt As Long del = Range("AH1:Ah10").Value2 ReDim X(1 To UBound(del, 1), 1 To UBound(del, 2)) Dim delChars As Long Dim delType As String For lngCnt = LBound(del, 1) To UBound(del, 1) If IsNumeric(del(lngCnt, 1)) Then If Len(Int((del(lngCnt, 1)))) = 8 Then X(lngCnt, 1) = DateSerial(Right$(del(lngCnt, 1), 4), Left$(del(lngCnt, 1), 2), Mid$(del(lngCnt, 1), 3, 2)) End If Next [ai1].Resize(UBound(X, 1), UBound(X, 2)).Value2 = X End Sub 

Answer 2

Right(Left(del(i, 1), 2), 6)是无意义的。

Left(del(i, 1), 2)部分首先发生并返回一个2个字符的string。 如果你然后应用Right(..., 6)到这个2个字符的string，你会得到一个错误。

Mid函数在这里需要： Mid(del(i, 1), 3, 2)

---

之前运行Abs函数将数组条目从具有子typesstring的变体更改为具有子types双精度的变体。 这不一定会影响左/中/右function，但请尝试：

 del(i, 1) = CStr(del(i, 1)) del(i, 1) = DateSerial((Right(del(i, 1), 4)), (Left(del(i, 1), 2)), (Mid(del(i, 1), 3, 2))) 

---

我们需要确定导致错误的实际值是什么：

 If delType = "Numeric" Then If delChars = 8 Then On Error Goto DateMismatchError del(i, 1) = DateSerial((Right(del(i, 1), 4)), (Left(del(i, 1), 2)), (Mid(del(i, 1), 3, 2))) '<-- TYPE MISMATCH ERROR On Error Goto 0 End If End If ' at the end of your Sub or Function - I'm assuming Sub here Exit Sub DateMismatchError: MsgBox "Date mismatch: error number " & Err.Number & ", " & Err.Description & _ " caused by data value: |" & del(i, 1) & "| at row " & i & ". Original data " & _ "value is |" & Range("AH" & i).Value2 & "|, displayed value is |" & _ Range("AH" & i).Text & "|, number format is |" & Range("AH" & i).NumberFormat & "|" End Sub