| |
こんにちは。
テキストオープンにちょっとバグみたいなのがあったんで、修正しておきました。
（私が気づかないだけで、他にもあるかもしんないけど．．．。）
テキストデータの最後が数字じゃないと実行エラーになる、バグ？？。
例えば
ああああ,いいいい,うううう
かかかか,きききき,くくくく
↑
ここ
ああああ,いいいい,"うううう"
とか、
ああああ,いいいい,12345
のだったら問題は無いんだけど．．。
私の言い分としては、文字列は""でくくっとけ、ってことでした。
それと、\、$にも対応させたんだけど、2000にはバグがあって、2000SR-1では$が\に勝手に変えられちゃいます。
ただの2000だと、逆だっだと様な．．．。
97SR-2では、ちゃんと読み込まれます。
エクセル2000での￥＄のバグの多さは、日本たたき？
自己満足と言う事で載せました。
Sub TE71()
Dim ReadData As String, myFieldInfo(), I As Long, CNT As Integer
Dim OpenFile As String, CommaCnt As Integer, WQoFlg As Integer
Dim FTypTB() As Integer, MojFlg As Integer
Dim StMsg As String, FieldData As String
OpenFile = Application.GetOpenFilename("ファイル (*.txt), *.txt")
If OpenFile = "False" Then
End
End If
STime = Now()
Open OpenFile For Input As #1
Line Input #1, ReadData
Close #1
CNT = 0: WQoFlg = 0: MojFlg = 0: FieldData = Empty
For I = 1 To Len(ReadData)
If Mid(ReadData, I, 1) = "," And (WQoFlg = 0 Or WQoFlg = 2) Then
CNT = CNT + 1
CommaCnt = CommaCnt + 1
ReDim Preserve FTypTB(1 To CNT)
If (MojFlg = 0 And WQoFlg = 0 Or (IsNumeric(FieldData) = True And _
(InStr(1, FieldData, "-") > 0 Or InStr(1, FieldData, ",") > 0))) Or _
(Left(FieldData, 1) = "\" Or Left(FieldData, 1) = "$") And _
IsNumeric(Mid(FieldData, 2)) Then
FTypTB(CNT) = 1
'↑ ExcelVBAのバグのため\記号は、文字として扱われる為、無意味だけど一応入れる。by2000SR1
'注）$は、\に変換されてしまう。手動にて文字形式の変更が必要。by2000SR1
Else
FTypTB(CNT) = 2
End If
FieldData = Empty
MojFlg = 0
WQoFlg = 0
ElseIf Mid(ReadData, I, 1) = Chr(34) And WQoFlg = 0 Then
WQoFlg = 1
ElseIf Mid(ReadData, I, 1) = Chr(34) And WQoFlg = 1 Then
WQoFlg = 2
If I = Len(ReadData) Then
CNT = CNT + 1
ReDim Preserve FTypTB(1 To CNT)
FTypTB(CNT) = 2
End If
ElseIf Mid(ReadData, I, 1) = "," And WQoFlg = 2 Then
WQoFlg = 0
MojFlg = 0
CommaCnt = CommaCnt + 1
ElseIf IsNumeric(Mid(ReadData, I, 1)) = False Then
MojFlg = 1
FieldData = FieldData & Mid(ReadData, I, 1)
'ここ、最後の文字が数字意外だとエラーになるのを修正。追加しただけだけど。
If Len(ReadData) = I Then
CNT = CNT + 1
ReDim Preserve FTypTB(1 To CNT)
FTypTB(CNT) = 2
End If
ElseIf I = Len(ReadData) And (MojFlg = 1 Or IsNumeric(Mid(ReadData, I, 1)) = False) Then
CNT = CNT + 1
ReDim Preserve FTypTB(1 To CNT)
If (IsNumeric(FieldData) = True And _
(InStr(1, FieldData, "-") > 0 Or InStr(1, FieldData, ",") > 0)) Or _
(Left(FieldData, 1) = "\" Or Left(FieldData, 1) = "$") And _
IsNumeric(Mid(FieldData, 2)) Then
FTypTB(CNT) = 1
'↑ ExcelVBAのバグのため\記号は、文字として扱われる為、無意味だけど一応入れる。by2000SR1
'注）$は、\に変換されてしまう。手動にて文字形式の変更が必要。by2000SR1
Else
FTypTB(CNT) = 2
End If
FieldData = Empty
MojFlg = 0
ElseIf I = Len(ReadData) Then
CNT = CNT + 1
ReDim Preserve FTypTB(1 To CNT)
FTypTB(CNT) = 1
MojFlg = 0
ElseIf Mid(ReadData, I, 1) <> Chr(34) Then
FieldData = FieldData & Mid(ReadData, I, 1)
End If
Next
ReDim myFieldInfo(1 To CommaCnt + 1)
For I = 1 To CommaCnt + 1
myFieldInfo(I) = Array(I, FTypTB(I))
Next
Workbooks.OpenText FileName:=OpenFile, _
DataType:=xlDelimited, Comma:=True, FieldInfo:=myFieldInfo
Erase FTypTB
Erase myFieldInfo
MsgBox "処理時間 " & Format(Now - STime, "hh:mm:ss")
End
End Sub
|
|
