| |
keinさん
▼Hirofumi さん：
ありがとうございます。
Keinさんのでうまく動きました
Hirohumiさんの
If vntField(i) Like vntKey Thenこの部分で
インデックスが範囲を超えていますと出てしまいました。
いかがでしょうか
>多分こんなで、同じ様な事をやると思いますが？
>ただし、CsvはSheetに展開をしません、直接ListBoxに代入されます
>尚、TextBox1に設定される値には、Like演算のでワイルドカード(?、*)が使用出来ます
>
>以下をUserFormのコードモジュールに全て記述して下さい
>
>Option Explicit
>
>'探索を行う、ListBoxに表示する列数(CSV先頭から7列)
>Private Const clngColumns As Long = 7
>
>'読み込むTextFile名
>Private vntFileName As Variant
>
>Private Sub CommandButton1_Click()
>
> Dim i As Long
> Dim j As Long
> Dim dfn As Integer
> Dim strBuff As String
> Dim strRec As String
> Dim blnMulti As Boolean
> Dim vntField As Variant
> Dim vntKey As Variant
>
> 'TextBox1に値が設定されて居なければ
> If TextBox1.Text = "" Then
> Beep
> Exit Sub
> Else
> 'TextBox1の値をKey文字とする
> vntKey = Trim(TextBox1.Text)
> End If
>
> 'ListBoxをクリア
> ListBox1.Clear
>
> 'CsvファイルをOpen
> dfn = FreeFile
> Open vntFileName For Input As dfn
>
> Do Until EOF(dfn)
> '１行読み込み
> Line Input #dfn, strBuff
> '論理レコードに物理レコードを追加
> strRec = strRec & strBuff
> '論理レコードをフィールドに分割
> vntField = SplitCsv(strRec, ",", , , blnMulti)
> 'フィールド内で改行が無い場合
> If Not blnMulti Then
> 'Csv先頭から7列の中にKey文字が含まれるか検査
> For i = 0 To clngColumns - 1
> '含まれている場合
> If vntField(i) Like vntKey Then
> Exit For
> End If
> Next i
> 'レコードにKey文字が有った場合
> If i <= clngColumns - 1 Then
> 'ListBox1に項目を追加
> With ListBox1
> .AddItem vntField(0)
> For j = 1 To clngColumns - 1
> .List(.ListCount - 1, j) = vntField(j)
> Next j
> End With
> End If
> strRec = ""
> End If
> Loop
>
> Close #dfn
>
>End Sub
>
>Private Sub UserForm_Initialize()
>
> ListBox1.ColumnCount = 7
>
>End Sub
>
>Private Sub UserForm_Activate()
>
> '読み込むファイル名を設定
> vntFileName = "db"
> 'ファイルを開くダイアログを表示
> If Not GetReadFile(vntFileName, ThisWorkbook.Path, False) Then
> Unload Me
> MsgBox "マクロがキャンセルされました", vbInformation
> End If
>
>End Sub
>
>Private Function SplitCsv(ByVal strLine As String, _
> Optional strDelimiter As String = ",", _
> Optional strQuote As String = """", _
> Optional strRet As String = vbCrLf, _
> Optional blnMulti As Boolean) As Variant
>
>' strLine :分割元と成る文字列
>' strDelimiter :区切り文字
>' SplitCsv :戻り値、切り出された文字配列
>
> Dim lngDPos As Long
> Dim vntData() As Variant
> Dim lngStart As Long
> Dim i As Long
> Dim vntField As Variant
> Dim lngLength As Long
>
> i = 0
> lngStart = 1
> lngLength = Len(strLine)
> blnMulti = False
> 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) & strRet
> lngStart = lngLength + 1
> Exit Do
> End If
> Loop
> End If
> vntData(i) = vntField
> vntField = Empty
> i = i + 1
> Loop Until lngLength < lngStart
>
> SplitCsv = vntData()
>
>End Function
>
>Private Function GetReadFile(vntFileNames As Variant, _
> Optional strFilePath As String, _
> Optional blnMultiSel As Boolean _
> = False) As Boolean
>
> Dim strFilter As String
>
> 'フィルタ文字列を作成
> strFilter = "CSV File (*.csv),*.csv," _
> & "Text File (*.txt),*.txt," _
> & "CSV and Text (*.csv; *.txt),*.csv;*.txt," _
> & "全て (*.*),*.*"
> '読み込むファイルの有るフォルダを指定
> If strFilePath <> "" Then
> 'ファイルを開くダイアログ表示ホルダに移動
> ChDrive Left(strFilePath, 1)
> ChDir strFilePath
> End If
> 'もし、ディフォルトのファイル名が有る場合
> If vntFileNames <> "" Then
> SendKeys vntFileNames & "{TAB}", False
> End If
> '「ファイルを開く」ダイアログを表示
> vntFileNames _
> = Application.GetOpenFilename(strFilter, 1, , , blnMultiSel)
> If VarType(vntFileNames) = vbBoolean Then
> Exit Function
> End If
>
> GetReadFile = True
>
>End Function
|
|
おおい
- 07/1/21(日) 18:25 -
