Excel VBA質問箱 IV

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

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


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

【6639】テキストファイルのインポート こうき 03/7/16(水) 15:14 質問
【6640】Re:テキストファイルのインポート Jaka 03/7/16(水) 15:54 回答
【6641】Re:テキストファイルのインポート こうき 03/7/16(水) 16:57 質問
【6642】Re:テキストファイルのインポート Jaka 03/7/16(水) 17:37 回答
【6643】Re:テキストファイルのインポート ichinose 03/7/16(水) 18:24 発言
【6644】ちょっと、訂正 ichinose 03/7/16(水) 18:34 発言
【6646】Re:ちょっと、訂正 こうき 03/7/17(木) 9:26 お礼
【6645】ありがとうございます こうき 03/7/17(木) 9:24 お礼

【6639】テキストファイルのインポート
質問  こうき  - 03/7/16(水) 15:14 -

引用なし
パスワード
   テキストファイルのインポートをマクロで行いたいのですが、その際、テキストファイルのインポートのダイアログボックスを表示して、インポートするテキストファイルを自由に選択できるようにしたいと思っているのですが、ダイアログボックスの表示方法が分からず困ってます。どうかご教授下さい。

【6640】Re:テキストファイルのインポート
回答  Jaka  - 03/7/16(水) 15:54 -

引用なし
パスワード
   こんにちは。

こういう事でしょうか?

Dim FileN As String
FileN = Application.GetOpenFilename("テキストファイル (*.txt), *.txt")
If FileN = "False" Then
  End
End If

【6641】Re:テキストファイルのインポート
質問  こうき  - 03/7/16(水) 16:57 -

引用なし
パスワード
   ▼Jaka さん:
ご返事ありがとうございます。

>Dim FileN As String
>FileN = Application.GetOpenFilename("テキストファイル (*.txt), *.txt")
>If FileN = "False" Then
>  End
>End If

これだと新しいファイルが開くのですが、マクロを実行する前に開いているファイルにテキストファイルの内容を表示させたいのです。
今のコードは
Sub input_hitetsu()

  With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\ _
      \デスクトップ\other.txt", Destination:=Range("A1"))
    .AdjustColumnWidth = False
    .TextFileParseType = xlFixedWidth
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileSpaceDelimiter = True
    .TextFileColumnDataTypes = Array(5, 1, 1, 1, 1, 1)
    .TextFileFixedColumnWidths = Array(7, 13, 15, 15, 15)
    .Refresh BackgroundQuery:=False
  End With
  
  With ActiveSheet.UsedRange
   MRow = .Rows(.Rows.Count).Row
  End With
  
End Sub

と書いているのですが、このother.txtの部分を自由に選択できるようにしたいのです。

さらに、欲を言えば
  .AdjustColumnWidth = False
  .TextFileParseType = xlFixedWidth
  .TextFileTextQualifier = xlTextQualifierDoubleQuote
  .TextFileSpaceDelimiter = True
  .TextFileColumnDataTypes = Array(5, 1, 1, 1, 1, 1)
  .TextFileFixedColumnWidths = Array(7, 13, 15, 15, 15)
  .Refresh BackgroundQuery:=False
の部分をテキストファイルを選択した後、自動的に行うようにできればと思っているのですが。

【6642】Re:テキストファイルのインポート
回答  Jaka  - 03/7/16(水) 17:37 -

引用なし
パスワード
   >これだと新しいファイルが開くのですが、
開きません。ファイルのフルパスを取得だけです。

現在クエリが使える環境でないので(EXL97)、前に2000で試行錯誤していた途中のコードをのせますので、これを参考にしてみてください。
だいぶ前のなんで、覚えていませんが多分動くと思います。

Sub 対応版()
  Dim OpenFile As String
  Dim TBL() As Long, DataCnt As Long, STRow As Long
  Dim ReadDete As String, DData As Variant
  OpenFile = Application.GetOpenFilename("テキストファイル (*.txt), *.txt")
  If OpenFile = "False" Then
    End
  End If

  Stime = Now()
  Open OpenFile For Input As #1
  Line Input #1, ReadDete
  DataCnt = DataCnt + 1
  Do Until EOF(1)
    Line Input #1, DData
    DataCnt = DataCnt + 1
  Loop
  Close #1
  CNT = 0: WクォFlg = 0
  Range("A4").Value = ReadDete
  For i = 1 To Len(ReadDete)
    Range("A3").Value = Mid(ReadDete, i, 1)
    If Mid(ReadDete, i, 1) = "," And (WクォFlg = 0 Or WクォFlg = 2) Then
      CNT = CNT + 1
      ReDim Preserve TBL(1 To CNT)
      If WクォFlg = 0 Then
       TBL(CNT) = 1
      Else
       TBL(CNT) = 2
      End If
      WクォFlg = 0
      カンマ数 = カンマ数 + 1
    ElseIf Mid(ReadDete, i, 1) = Chr(34) And WクォFlg = 0 Then
      WクォFlg = 1
    ElseIf Mid(ReadDete, i, 1) = Chr(34) And WクォFlg = 1 Then
      WクォFlg = 2
    ElseIf Mid(ReadDete, i, 1) = "," And WクォFlg = 2 Then
      WクォFlg = 0
      カンマ数 = カンマ数 + 1
    ElseIf i = Len(ReadDete) Then
      CNT = CNT + 1
      ReDim Preserve TBL(1 To CNT)
      TBL(CNT) = 1
    End If
  Next
  
  Range("B2").Resize(, カンマ数 + 1).Value = TBL
  
  STAdd = StartAddSet
  
  huhu = Range(STAdd).Row
  popo = (Range(STAdd).Row + DataCnt - 1)
  yuio = Cells.Rows.Count - (Range(STAdd).Row + DataCnt - 1)
  
  STRow = 1
  If DataCnt > Cells.Rows.Count * 2 Then
    MsgBox DataCnt & "以上は、このマクロでは無理です。"
    End
  ElseIf Cells.Rows.Count - (Range(STAdd).Row + DataCnt - 1) >= 0 Then
    LPC = 1
  Else
    Ag = (Range(STAdd).Row + DataCnt) - Rows.Count
    LPC = 2
  End If
   
  'End
  
  For i = 1 To LPC
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & OpenFile, _
       Destination:=Range(STAdd))
      .AdjustColumnWidth = False
      .TextFilePlatform = xlWindows
      .TextFileStartRow = STRow
      .TextFileParseType = xlDelimited
      .TextFileTextQualifier = xlTextQualifierDoubleQuote
      .TextFileConsecutiveDelimiter = False
      .TextFileTabDelimiter = True
      .TextFileSemicolonDelimiter = False
      .TextFileCommaDelimiter = True
      .TextFileSpaceDelimiter = False
      .TextFileColumnDataTypes = TBL
      .Refresh BackgroundQuery:=False
    End With
    If LPC = 2 And i = 1 Then
      '3537
      'STRow = DataCnt - (Range(STAdd).Row + DataCnt - 1) - Rows.Count
      STRow = Rows.Count - Range(STAdd).Row + 1
      AcShNam = ActiveSheet.Name
      Worksheets.Add(After:=ActiveSheet).Name = AcShNam & "-2"
      Application.DisplayAlerts = False
    End If
  Next
  Application.DisplayAlerts = True
  Erase TBL
  MsgBox Format(Now() - Stime, "hh:mm:ss") & vbCrLf & OpenFile
  End
End Sub

Private Function StartAddSet() As String
  Dim StartAdd As Range
  On Error Resume Next
  Set StartAdd = Application.InputBox(Prompt:="書込む最初のセルをクリックして下さい。", _
             Title:="書込み位置の選択", Default:=ActiveCell.Address, Type:=8)
  If StartAdd Is Nothing Then
    Set StartAdd = Nothing
    End
  ElseIf StartAdd.Count <> 1 Then
    Set StartAdd = Nothing
    End
  Else
    StartAddSet = StartAdd.Address(0, 0)
  End If
  On Error GoTo 0
  Set StartAdd = Nothing
End Function

【6643】Re:テキストファイルのインポート
発言  ichinose  - 03/7/16(水) 18:24 -

引用なし
パスワード
   Jaka さん、こうきさん、こんばんは。
横から失礼します。

いろんな設定をユーザーに選択させたいなら、
Excelに全部頼んでしまうと言う方法は?
'===========================================
Sub test()
  Dim ans
  ans = Application.Dialogs(xlDialogImportTextFile).Show
  If ans = True Then
    MsgBox "処理完了"
  Else
    MsgBox "処理中断"
    End If
End Sub

どうでしょうか?

【6644】ちょっと、訂正
発言  ichinose  - 03/7/16(水) 18:34 -

引用なし
パスワード
   on error を宣言しておかないとエラーになってしまうようなので・・・。

>いろんな設定をユーザーに選択させたいなら、
>Excelに全部頼んでしまうと言う方法は?
>'===========================================
>Sub test()
   on error resume next
>  Dim ans
>  ans = Application.Dialogs(xlDialogImportTextFile).Show
   if err.number<>0 then ans=false
>  If ans = True Then
>    MsgBox "処理完了"
>  Else
>    MsgBox "処理中断"
>    End If
   on error goto 0
>End Sub
>
>どうでしょうか?

【6645】ありがとうございます
お礼  こうき  - 03/7/17(木) 9:24 -

引用なし
パスワード
   ▼Jaka さん:
>現在クエリが使える環境でないので(EXL97)、前に2000で試行錯誤していた途中のコードをのせますので、これを参考にしてみてください。
>だいぶ前のなんで、覚えていませんが多分動くと思います。

ありがとうございます。無事動くようになりました。
ただ教えて頂いたコードで分からない部分があるので、これから理解に努めます。

【6646】Re:ちょっと、訂正
お礼  こうき  - 03/7/17(木) 9:26 -

引用なし
パスワード
   ▼ichinose さん:

>>いろんな設定をユーザーに選択させたいなら、
>>Excelに全部頼んでしまうと言う方法は?
>>'===========================================
>>Sub test()
>   on error resume next
>>  Dim ans
>>  ans = Application.Dialogs(xlDialogImportTextFile).Show
>   if err.number<>0 then ans=false
>>  If ans = True Then
>>    MsgBox "処理完了"
>>  Else
>>    MsgBox "処理中断"
>>    End If
>   on error goto 0
>>End Sub
>>
>>どうでしょうか?

ユーザーがインポートの形式を選択する形になりますね。
こういう方法もあるという勉強になりました。
教えて頂いたコードを基にいろいろと加えてこれから試してみようと思います。
ありがとうございました。

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