Excel VBA質問箱 IV

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

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


17120 / 76732 ←次へ | 前へ→

【65069】Re:指定文字間の削除について
発言  Hirofumi  - 10/4/11(日) 7:30 -

引用なし
パスワード
   ▼たろー さん:
>はじめまして。
>
>PL/SQLで作成したファイルを、
>エクセルに取り込む際に、コメント行を削除した状態で
>エクセルに一括取り込みを実施したいと思っています。
>
>ファイル取り込み処理は実現できたのですが、
>コメント行の削除がどうしてもうまくできません。
>(よい実装方法が思いつかない)
>
>どなたか効率よく実現できる方法ご存知ないでしょうか?
>
>ちなみに、下記の2種類のパターンを想定しています。
> 1. --で始まる対象行(--〜改行コードまでの1行)
> 2. /* 〜 */の間 (複数行に跨ぐ場合あり)
>
>よろしくお願いします。

良く解らないけど?
テクストファイルとして扱うとすれば、こんなので善いのかな?

Option Explicit

Public Sub Sample()

  Dim i As Long
  Dim dfn As Integer
  Dim vntFileName As Variant
  Dim strBuff As String
  Dim bytBuff() As Byte
  Dim strResult() As String
  
  vntFileName = Application.GetOpenFilename("全て (*.*),*.*")
  If VarType(vntFileName) = vbBoolean Then
    Exit Sub
  End If
  
  dfn = FreeFile
  Open vntFileName For Binary As dfn
    ReDim bytBuff(1 To LOF(dfn))
    Get #dfn, , bytBuff
  Close #dfn
  
  strBuff = StrConv(bytBuff, vbUnicode)
  Erase bytBuff
  
  DeleteData1 strBuff
  DeleteData2 strBuff
  
  strResult = Split(strBuff, vbCrLf)
  ActiveSheet.Range("A1").Resize(UBound(strResult) + 1) _
      = Application.WorksheetFunction.Transpose(strResult)

  MsgBox "処理が完了しました", vbInformation
  
End Sub

Private Sub DeleteData1(strData As String)

'  1. --で始まる対象行(--〜改行コードまでの1行)

  Const cstrFind As String = "--"
  
  Dim i As Long
  Dim lngPos1 As Long
  Dim lngPos2 As Long
  
  lngPos1 = InStr(1, strData, cstrFind, vbBinaryCompare)
  Do Until lngPos1 = 0
    lngPos2 = InStr(lngPos1 + 1, strData, vbCrLf, vbBinaryCompare)
    If lngPos2 = 0 Then
      Exit Do
    End If
    strData = Left(strData, lngPos1 - 1) & Mid(strData, lngPos2)
    lngPos1 = InStr(1, strData, cstrFind, vbBinaryCompare)
  Loop

End Sub

Private Sub DeleteData2(strData As String)

'  2. /* 〜 */の間 (複数行に跨ぐ場合あり)

  Const cstrFind1 As String = "/*"
  Const cstrFind2 As String = "*/"
  
  Dim i As Long
  Dim lngPos1 As Long
  Dim lngPos2 As Long
  
  lngPos1 = InStr(1, strData, cstrFind1, vbBinaryCompare)
  Do Until lngPos1 = 0
    lngPos2 = InStr(lngPos1 + 1, strData, cstrFind2, vbBinaryCompare)
    If lngPos2 = 0 Then
      Exit Do
    End If
    strData = Left(strData, lngPos1 - 1) & Mid(strData, lngPos2 + 2)
    lngPos1 = InStr(1, strData, cstrFind1, vbBinaryCompare)
  Loop

End Sub

0 hits

【65068】指定文字間の削除について たろー 10/4/11(日) 1:44 質問
【65069】Re:指定文字間の削除について Hirofumi 10/4/11(日) 7:30 発言
【65078】Re:指定文字間の削除について たろー 10/4/12(月) 20:55 お礼

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