Excel VBA質問箱 IV

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

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


6335 / 13644 ツリー ←次へ | 前へ→

【45836】テキスト ChinaCoffee 07/1/15(月) 19:56 質問[未読]
【45838】Re:テキスト Kein 07/1/15(月) 21:58 発言[未読]
【45839】Re:テキスト ichinose 07/1/15(月) 22:20 発言[未読]
【45842】Re:テキスト Kein 07/1/16(火) 0:38 回答[未読]
【45845】Re:テキスト ChinaCoffee 07/1/16(火) 6:09 お礼[未読]

【45836】テキスト
質問  ChinaCoffee  - 07/1/15(月) 19:56 -

引用なし
パスワード
   以下のようなフォマトのテキストファイルから[MAP]の部分だけとりだせますでしょうか?よろしくお願いします。
{
{
[MAP1]
10 20
11 35
12 45
18 21
;
[cha]
10 30
16 22
78 99
;
}
{
[MAP2]
34 25
35 98
36 43
37 88
;
[cha]
36 99
24 55
14 13
;
}
}
マクロ後↓

[MAP1]
10 20
11 35
12 45
18 21
[MAP2]
34 25
35 98
36 43
37 88

【45838】Re:テキスト
発言  Kein  - 07/1/15(月) 21:58 -

引用なし
パスワード
   今ちょっと時間がないのでヒントだけ。
Openステートメントで変数に一行読み込み↓

Line Input #1, Buf

先頭の文字を判定し、フラグの値を切り替える↓

Select Case Left$(Buf, 4)
  Case "[MAP": Flg = True
  Case "[cha": Flg = False
End Select

Flgが True の間だけセルに取り込む。

If Flg Then
  i = i + 1
  Cells(i, 1).VBalue = Buf
End If

てな感じで良いと思います。

【45839】Re:テキスト
発言  ichinose  - 07/1/15(月) 22:20 -

引用なし
パスワード
   こんばんは。
>以下のようなフォマトのテキストファイルから[MAP]の部分だけとりだせますでしょうか?よろしくお願いします。
このテキストファイルを仮に Sample.Txtというファイル名だとします。

>{
>{
>[MAP1]
>10 20
>11 35
>12 45
>18 21
>;
>[cha]
>10 30
>16 22
>78 99
>;
>}
>{
>[MAP2]
>34 25
>35 98
>36 43
>37 88
>;
>[cha]
>36 99
>24 55
>14 13
>;
>}
>}
>マクロ後↓
>
>[MAP1]
>10 20
>11 35
>12 45
>18 21
>[MAP2]
>34 25
>35 98
>36 43
>37 88

新規ブックの標準モジュールに

'=======================================================
Sub main()
  Dim fno As Long
  Dim wmode As Boolean
  Dim g0 As Long
  Dim dat As String
  g0 = 1
  wmode = False
  Call create_RegExp
  fno = FreeFile()
  Open "d:\****\***\sample.txt" For Input As #fno
'      ↑ここにテキストファイルのパスを記述する
  Do Until EOF(fno)
    Line Input #fno, dat
    If findchk(dat, "\[.+\]") Then
     If findchk(dat, "\[MAP[0-9]+\]") Then
       wmode = True
     Else
       wmode = False
       End If
     End If
    If wmode = True Then
     Cells(g0, 1).Value = dat
     g0 = g0 + 1
     End If
    Loop
  Call term_RegExp
End Sub

別の標準モジュールに
'========================================================
Option Explicit
'========================================================
Private regEx As Object
'========================================================
Sub create_RegExp()
    Set regEx = CreateObject("VBScript.RegExp")
End Sub
'========================================================
Function findchk(ByVal mystr As String, _
         ByVal chkstr As String, _
         Optional ByVal chknum As Long = 1) As Boolean
  Dim Matches As Object
  Dim idx As Long
  findchk = False
  regEx.Pattern = chkstr
  regEx.IgnoreCase = True
  regEx.Global = True
  Set Matches = regEx.Execute(mystr)
  If Matches.Count = chknum Then
   findchk = True
   End If
  Set Matches = Nothing
End Function
'========================================================
Sub term_RegExp()
  Set regEx = Nothing
End Sub

これでmainを実行してください。

アクティブシートのA列に
[MAPxx]以下の条件にあったデータのみが表示されます。

正規表現を使いました。

【45842】Re:テキスト
回答  Kein  - 07/1/16(火) 0:38 -

引用なし
パスワード
   ↓これでテストしてみたら、一応うまくいきましたが・・。

Sub MAP_DataGet()
  Dim Buf As String
  Dim i As Long
  Const MyF As String = _
  "C:\Documents and Settings\User\MyTest.txt"
  '↑ファイルのフルパスは正確に
 
  Open MyF For Input Access Read As #1
  Do Until EOF(1)
   Line Input #1, Buf
   If Left$(Buf, 1) = "[" Then
     Select Case Left$(Buf, 4)
      Case "[MAP": Flg = True
      Case "[cha": Flg = False
     End Select
   End If
   If Flg Then
     i = i + 1
     Cells(i, 1).Value = Buf
   End If
  Loop
  Close #1: MsgBox "取り込み終了"
End Sub

【45845】Re:テキスト
お礼  ChinaCoffee  - 07/1/16(火) 6:09 -

引用なし
パスワード
   早速ありがとうございます。
しかも有名なお二方に!

(ヒントだけでも大変助かります)
今日出社したら組み込みます。
ありがとうございました。

6335 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free