| |
>現状のエラーは下記の通りです｡
>アプリケーション定義またはオブジェクトのエラーです｡
>.Value = vntField で止まります。
>
>1 セルの文字数は1000以上のものもあり今後増える可能性もあります｡
>=で始まるセルも有り得ます。
ここで止まるのは、前回のレスの多分1、2、に該当すると思われます
「1、」に該当する部分は、フィールドの文字数が、911文字を超えた場合
セルへの代入方法を1セルづつに替えれば出来ると思います
ただし、セルの文字数の上限も有りますので(2000文字？)気を付けて下さい
「2、」の場合は、代入するセルの書式を文字列にするか、
「=」を違う文字に差し替えれば善いと思います
マイクロソフトの以下の資料を見て下さい
[XL2003] 長い文字列配列を代入すると "実行時エラー 1004" が発生する
ｈｔｔｐ://support.microsoft.com/kb/818808/ja
Excel のセルに表示されるのは 1,024 文字のみ
ｈｔｔｐ://support.microsoft.com/kb/211580/ja
以下のコードは、「1、」の問題に対処して見ました
Private Sub CSVRead(ByVal strFileName As String, _
ByRef rngWrite As Range, _
Optional ByRef lngRow As Long = 1, _
Optional strDelim As String = ",")
Dim i As Long '★追加
Dim blnNormal As Boolean '★追加
Dim dfn As Integer
Dim vntField As Variant
Dim strBuff As String
Dim blnMulti As Boolean
Dim strRec As String
'ファイルをOpen
dfn = FreeFile
Open strFileName For Input As dfn
Do Until EOF(dfn)
'１行読み込み
Line Input #dfn, strBuff
'論理レコードに物理レコードを追加
strRec = strRec & strBuff
'論理レコードをフィールドに分割 引数追加に因り変更
' vntField = SplitCsv(strRec, strDelim, , , blnMulti)
vntField = SplitCsv(strRec, strDelim, blnNormal, , , blnMulti) '★変更
'フィールド内で改行が有る場合
If Not blnMulti Then
With rngWrite.Offset(lngRow)
'出力範囲を文字列に設定(フィールド先頭の「=」対する対処)
' .Resize(, UBound(vntField) + 1).NumberFormat = "@" '★変更
'もし、全フィールドの文字数が911以内の場合
If blnNormal Then '★追加
'データを配列として出力
.Resize(, UBound(vntField) + 1).Value = vntField '★追加
Else '★追加
'データを1づつセルに代入
For i = 0 To UBound(vntField) '★追加
.Offset(, i).Value = vntField(i) '★追加
Next i '★追加
End If '★追加
End With '★追加
'出力行をインクリメント
lngRow = lngRow + 1
strRec = ""
Else
'セル内改行として残す場合
strRec = strRec & vbLf
End If
Loop
Close #dfn
End Sub
Private Function SplitCsv(ByVal strLine As String, _
Optional strDelimiter As String = ",", _
Optional blnNormal As Boolean, _
Optional strQuote As String = """", _
Optional strRet As String = vbCrLf, _
Optional blnMulti As Boolean) As Variant
' ★引数に「blnNormal As Boolean」を追加
Dim i As Long
Dim lngDPos As Long
Dim vntData() As Variant
Dim lngStart As Long
Dim vntField As Variant
Dim lngLength As Long
i = 0
lngStart = 1
lngLength = Len(strLine)
blnMulti = False
blnNormal = True '★追加
Do
ReDim Preserve vntData(i)
If Mid$(strLine, lngStart, 1) <> strQuote Then
lngDPos = InStr(lngStart, strLine, _
strDelimiter, vbBinaryCompare)
If lngDPos > 0 Then
vntField = Mid$(strLine, lngStart, _
lngDPos - lngStart)
If lngDPos = lngLength Then
ReDim Preserve vntData(i + 1)
End If
lngStart = lngDPos + 1
Else
vntField = Mid$(strLine, lngStart)
lngStart = lngLength + 1
End If
Else
lngStart = lngStart + 1
Do
lngDPos = InStr(lngStart, strLine, _
strQuote, vbBinaryCompare)
If lngDPos > 0 Then
vntField = vntField & Mid$(strLine, _
lngStart, lngDPos - lngStart)
lngStart = lngDPos + 1
Select Case Mid$(strLine, lngStart, 1)
Case ""
Exit Do
Case strDelimiter
lngStart = lngStart + 1
Exit Do
Case strQuote
lngStart = lngStart + 1
vntField = vntField & strQuote
End Select
Else
blnMulti = True
vntField = Mid$(strLine, lngStart)
lngStart = lngLength + 1
Exit Do
End If
Loop
End If
'フィールドの文字数が911を超えた場合
If Len(vntField) > 911 Then '★追加
blnNormal = False '★追加
End If '★追加
vntData(i) = vntField
vntField = Empty
i = i + 1
Loop Until lngLength < lngStart
SplitCsv = vntData()
End Function
尚、「2、」で「=」を別な文字に差し替えるなら、「Function SplitCsv」の中の
「vntData(i) = vntField」因り前で行えば善いと思います
|
|
Hirofumi
- 07/8/15(水) 20:12 -
