1

問題

配列内で 8 桁の数値を日付に変換しようとしています。エントリの例は、12282009 または 12202007 です。文字列として入力された日付を含む、他の不正なエントリがフィールドに含まれています。8 桁の数字をそれぞれ 12/28/09 または 12/20/07 としてフォーマットする必要があります。以下の 3 行目から最後の行で型の不一致エラーが発生し続けます。どうすればいいですか??

コード

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

エントリーテンプレート

9月 25, 20 (いいえ、いいえ、削除してください。)
SEPT (いいえ、役に立たない、削除してください。)
N/A (くだらない! 削除してください。)
LONG TIME AG (ばかがこれを良い考えだと思った、削除してください。)
JUNE 30 , 200 (どうやらこのフィールドは 12 文字しか保持しないようです。削除します。)
CHARGED OFF (役に立たない、削除します。)
94 DAYS (スペースの前のすべての文字を取り、注文日を含む他のフィールドから差し引いて、延滞日を取得します。)
94 DPD (DPD in 2008-7-15
12 (追加番号がわからないので、スペースの前のすべての文字を取り出して変換してください。)
INVALID (削除)
BLANK (何もしない。)
4/2/4/09 (不正な日付、削除。)
1/1/009 (上記と同じ。)
12282009 (ネストされた LEFT と RIGHT を使用し、間に / を挟んで CONCATENATE を使用。)
9202011 (先頭に追加0、その後は上記と同じ)
92410 (先行ゼロを追加、これは 09/24/10 に変換されます)
41261 (1899 年 12 月 31 日からの日数、これは 12/08/12 に変換されます)
1023 (滞納からの日数、 ORDER DATE から延滞日を引く。)
452 (同上)
12 (同上)
1432.84 (金額、IQ の低い怠け者が誤って入力した。削除。)

4

2 に答える 2

1

この短いコードを使用して、配列要素を書式設定された日付に置き換えることができます

  1. これにより、ループ内のテストの量が 2 秒に削減されますIF。数値テストが最初に実行される場合 - 8 文字以外の文字列に対してより長い
  2. 文字列関数などは、バリアントのいとこなどLeft$よりMid$もはるかに高速LeftですMid

importwsRowCount以下のコードで変数を置換しました

結果を処理してダンプするようにコードを更新し、barrowc コメントに従って文字列テストと準拠していない数値を処理するようになりました

以下のコードは、新しい日付を 2 番目の配列に入れ、無効な日付をスキップします。2 番目の配列は `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

ここに画像の説明を入力

于 2012-11-06T23:30:23.983 に答える
1

Right(Left(del(i, 1), 2), 6)無意味です。

このLeft(del(i, 1), 2)部分が最初に発生し、2 文字の文字列を返します。Right(..., 6)その 2 文字の文字列に適用すると、エラーが発生します。

ここMidで関数が必要です：Mid(del(i, 1), 3, 2)

前に関数を実行するとAbs、配列エントリがサブタイプ String の Variant からサブタイプ Double の Variant に変更されました。これは必ずしも Left/Mid/Right 機能に影響するわけではありませんが、次のことを試してください。

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
于 2012-11-06T22:55:59.637 に答える