| |
ま、半分冗談の積もりで作って見ました
条件は、
Array(10, 15, 5, 8, 3, 5, 10（文字）, 5, 10（文字）, 2, 6, 6, 6, 6)
の中で、2ヶ所「10（文字）」の位置が、不定数の全角文字と半角スペースで構成され
その他のフィールドは、半角数字で構成されたTextで
1行づつ改行されている物と考えます
上手く行かなかったらゴメン
Option Explicit
Public Sub Sample()
Dim i As Long
Dim lngRow As Long
Dim dfn As Integer
Dim vntFileName As Variant
Dim strBuff As String
Dim vntField As Variant
Dim rngResult As Range
Dim strDataPath As String
'データの有るPathを指定
' strDataPath = "C:\Documents and Settings\Owner\My Documents"
'ファイル名を指定(拡張子は無し、ここを指定しなければ、
'指定された拡張子の全てのファイル名表示）
' vntFileName = "でーたもと"
'ファイルを開くダイアログ表示
If Not GetReadFile(vntFileName, strDataPath) Then
Exit Sub
End If
'結果を書き込むシートの先頭セル位置を指定
Set rngResult = ActiveSheet.Cells(1, "A")
'ファイルをInputモードでOpen
dfn = FreeFile
Open vntFileName For Input As dfn
'ファイルEndまで繰り返し
Do Until EOF(dfn)
'1行変数に読み込み
Line Input #dfn, strBuff
'1行をフィールドに分割
vntField = DataSplit(strBuff)
'指定したシートの指定したセルに就いて
With rngResult.Offset(lngRow)
'先頭2セルの書式を文字列に指定
.Resize(, 2).NumberFormatLocal = "@"
'指定したシートにデータを書き込み
.Resize(, UBound(vntField) + 1).Value = vntField
End With
'書き込み行を更新
lngRow = lngRow + 1
Loop
'ファイルをClose
Close #dfn
Set rngResult = Nothing
Beep
MsgBox "処理が完了しました"
End Sub
Private Function DataSplit(strMark As String) As Variant
Dim i As Long
Dim lngPos As Long
Dim vntSplit As Variant
Dim vntField As Variant
Dim strLetter As String
'フィールド長を指定（-1の場合、半角数字が出るまで文字を連結）
vntSplit = Array(10, 15, 5, 8, 3, 5, -1, 5, -1, 2, 6, 6, 6, 6)
'結果用配列を確保
ReDim vntField(UBound(vntSplit))
'読み込み位置の初期値設定
lngPos = 1
'フィールド数分繰り返し
For i = 0 To UBound(vntSplit)
'もし、フィールド長が-1で無ければ
If vntSplit(i) <> -1 Then
'読み込み位置から、指定フィールド長分文字を切り出して
'結果用配列に格納
vntField(i) = Mid(strMark, lngPos, vntSplit(i))
'読み込み位置を更新
lngPos = lngPos + vntSplit(i)
Else
'-1の場合、半角数字が出るまで文字を連結
strLetter = Mid(strMark, lngPos, 1)
Do Until 48 <= Asc(strLetter) And Asc(strLetter) <= 57
vntField(i) = vntField(i) + strLetter
lngPos = lngPos + 1
strLetter = Mid(strMark, lngPos, 1)
Loop
End If
Next i
'戻り値として、結果用配列を返す
DataSplit = vntField
End Function
|
|
Hirofumi
- 05/5/31(火) 20:57 -
