Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

74685 / 76732

←次へ　｜　前へ→


	【6507】Re:テキストデータからの抽出

Hirofumi

- 03/7/4(金) 20:49 -


	引用なし

	パスワード

こんなで善いのかな？
当方Excel97なので、Split関数がない為、その部分も作って居ますが
Excel2000以上なら、以下部分をSplit関数にした方が善いと思います
　　　　　　'１行の４文字目以降をフィールドに分割
　　　　　　vntField = Split97(Mid(strBuff, 4), " ")
を
　　　　　　'１行の４文字目以降をフィールドに分割
　　　　　　vntField = Split(Mid(strBuff, 4), " ")
に変更
その場合、Function Split97はいりません

Public Sub TextRead()

　　Dim dfn As Integer
　　Dim vntFileName As Variant
　　Dim strFileFilter As String
　　Dim strBuff As String
　　Dim vntField As Variant
　　Dim lngWriteRow As Long
　　
　　'「ファイルを開く」ダイアログを表示
　　strFileFilter = "TextFile (*.txt),*.txt,CsvFile (*.csv),*.csv"
　　vntFileName = Application.GetOpenFilename(strFileFilter, 1)
　　'もし、キャンセルされた場合Subを抜ける
　　If vntFileName = False Then
　　　　Exit Sub
　　End If
　　
'　　Application.ScreenUpdating = False
　　
　　'ファイルバッファ番号を取得
　　dfn = FreeFile
　　'ファイルをInputモードで開く
　　Open vntFileName For Input As dfn
　　
　　'書き込み行の初期値を設定
　　lngWriteRow = 1
　　'ファイルエンドまで繰り返し
　　Do Until EOF(dfn)
　　　　'ファイルから１行読み込み
　　　　Line Input #dfn, strBuff
　　　　'行の先頭２文字がCOで有るならば
　　　　If StrComp(Left(strBuff, 2), _
　　　　　　　　　　　　"CO", vbTextCompare) = 0 Then
　　　　　　'１行の４文字目以降をフィールドに分割
　　　　　　vntField = Split97(Mid(strBuff, 4), " ")
　　　　　　'アクティブシートの書き込み行、1列を指定
　　　　　　With Cells(lngWriteRow, 1)
　　　　　　　　'データの書き込み
　　　　　　　　Range(.Offset(, 0), _
　　　　　　　　　　　　.Offset(, UBound(vntField))).Value _
　　　　　　　　　　　　　　　　　　　　　　　　　　　　= vntField
　　　　　　End With
　　　　　　'書き込み行を更新
　　　　　　lngWriteRow = lngWriteRow + 1
　　　　End If
　　Loop
　　
　　'ファイルを閉じる
　　Close #dfn
　　
'　　Application.ScreenUpdating = True
　　
End Sub

Public Function Split97(ByVal vntValue As Variant, _
　　　　　　　　　　　　Optional ByVal strDelimiter As String = ",", _
　　　　　　　　　　　　Optional ByVal intCompare As Integer _
　　　　　　　　　　　　　　　　　　　　　 = vbBinaryCompare) As Variant

　　Dim i As Long
　　Dim vntData() As Variant
　　Dim lngPos As Long
　　Dim intDelLen As Integer
　　
　　If intCompare <> vbBinaryCompare Then
　　　　intCompare = vbTextCompare
　　End If
　　If strDelimiter = "" Then
　　　　ReDim vntData(0)
　　　　vntData(0) = vntValue
　　　　Split97 = vntData
　　　　Exit Function
　　End If
　　If vntValue = "" Then
　　　　Split97 = ""
　　　　Exit Function
　　End If
　　intDelLen = Len(strDelimiter)
　　
　　i = 0
　　ReDim vntData(i)
　　lngPos = InStr(1, vntValue, strDelimiter, intCompare)
　　Do Until lngPos = 0
　　　　vntData(i) = Left(vntValue, lngPos - 1)
　　　　vntValue = Mid(vntValue, lngPos + intDelLen)
　　　　i = i + 1
　　　　ReDim Preserve vntData(i)
　　　　lngPos = InStr(1, vntValue, strDelimiter, intCompare)
　　Loop
　　vntData(i) = vntValue
　　　　
　　Split97 = vntData
　　
End Function

0 hits

▼

【6505】テキストデータからの抽出 いわまる 03/7/4(金) 18:17