Excel VBA質問箱 IV

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

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


74 / 13006 ツリー ←次へ | 前へ→

【78796】VBAに行き詰りました。助けてください。 りり 17/2/2(木) 14:52 質問[未読]

【78798】Re:VBAに行き詰りました。助けてください。 β 17/2/2(木) 18:49 発言[未読]
【78799】Re:VBAに行き詰りました。助けてください。 りり 17/2/3(金) 9:35 お礼[未読]
【78800】Re:VBAに行き詰りました。助けてください。 β 17/2/3(金) 10:50 発言[未読]
【78801】Re:VBAに行き詰りました。助けてください。 りり 17/2/3(金) 11:23 質問[未読]
【78802】Re:VBAに行き詰りました。助けてください。 りり 17/2/3(金) 13:15 質問[未読]
【78803】Re:VBAに行き詰りました。助けてください。 β 17/2/3(金) 23:38 発言[未読]
【78804】Re:VBAに行き詰りました。助けてください。 β 17/2/4(土) 0:42 発言[未読]
【78805】Re:VBAに行き詰りました。助けてください。 りり 17/2/4(土) 14:27 お礼[未読]

【78798】Re:VBAに行き詰りました。助けてください...
発言  β  - 17/2/2(木) 18:49 -

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

とりあえずコンパイルエラーがでないコードに修正しました。
質問箱の掲示板上の制約で、コードが(WEB上)改行されて醜いのですが
コピペしてモジュールに貼り付けると、見やすくなるかと思います。

つけられたコメントそのものがおかしなところや、コードを変えたほうがいいところは
★をつけてなおしてあります。

コンパイラーレベルの修正ですから、ロジック自体が大丈夫かどうかの検証はしていません。

ところで、

  Dim moji As String, nlen, nPos, number, kensaku As String  '変数宣言でmoji, nlen, nPos, numberを作成。

型が明記されていない変数はすべて Variant型になります。実行上支障はありませんが
As Long であるとか As Object であるとか、すべて明記したほうがわかりやすいですね。

Sub MakeFileLis2() 'Subプロシージャ

  Dim A As String, Chiba, Chiba1, Chiba2 As String '変数宣言でAとChibaとChiba1とChiba2を作成。
  Dim moji As String, nlen, nPos, number, kensaku As String  '変数宣言でmoji, nlen, nPos, numberを作成。
  Dim i As Long    '★変数追加
  
  With Application.FileDialog(msoFileDialogFolderPicker)
    If Not .Show Then Exit Sub 'もし選ばれずキャンセルボタンが押されたら処理を終了する
    A = .SelectedItems(1)  '★SelectedItems は複数形です。コレクションです。その1番目。また、これは文字列情報ですから Set で格納してはいけません
  End With 'With〜End Withステートメントの終わり

  Application.ScreenUpdating = False '★画面の更新を抑止する
  Set Chiba1 = CreateObject("Scripting.FileSystemObject")  'オブジェクトを作成する関数
  With ThisWorkbook.Sheets("Sheet1")
    .UsedRange.ClearContents    '★使用領域をクリアする もし結合セルがあるシートなら .UsedRange.Value = Empty にしてください
    With .Range("B2:E2")  '見出しを付ける
      .Value = Array("ファイル名", "ファイル種別", "文字数", "半角の有無")  '見出しの文字を設定する
      .Interior.Color = vbBlack    '見出しの背景色を黒に設定する   ★ vbBlack のほうがわかりやすいですね。
      .Font.Color = vbWhite      '見出しの文字色を白に設定する  ★ vbWhite のほうがわかりやすいですね。
      .HorizontalAlignment = xlCenter  'セルの中の文を中央揃えにする
    End With  'With〜End Withステートメントの終わり
    i = 2  '変数 i に 2 を代入
    For Each Chiba In Chiba1.GetFolder(A).Files  'For Each でAという名前の箱の中身をループ処理
      i = i + 1  '変数 i を3にする(列が3段下がる)
      .Cells(i, 2).Value = Chiba.Name  'ファイル名を書き出す
      .Cells(i, 3).Value = Chiba.Type  'ファイル種別を書き出す
      number = FreeFile  ''numberはフリーファイルです


      Open A For Input As #number  'Aファイルのnumberというファイル番号を読み込む
      Do While Not EOF(number)  'numberの末尾に行くまで繰り返す
        Line Input #number, moji  'numberというファイル番号から1行ずつデータを読み込み、mojiに格納する
        If nPos <> StrConv(moji, vbWide) Then
          'mojiで半角文字文字列内の半角文字 (1 バイト) を全角文字 (2 バイト) に変換出来なかった場合
          .Cells(i, 5).Value = "半角の文字があります。"  '半角文字があると書き込む
        Else
          .Cells(i, 5).Value = "半角の文字はありません。"  '半角文字が無いと書き込む
          Close #number  'numberを閉じる

        End If  'if〜End Ifの終わり
      Loop  '繰り返す
    Next Chiba  'この処理を繰り返す
  End With  'With〜End Withステートメントの終わり
  
  Application.ScreenUpdating = True  ''★ 画面の更新を再開する


End Sub 'Subプロシージャ終わり

【78799】Re:VBAに行き詰りました。助けてください...
お礼  りり  - 17/2/3(金) 9:35 -

引用なし
パスワード
   β さん
ありがとうございます。
さまざまなインターネット上のコードと応用のテキストのみで作成いたしましたが、
まだ1週間ほどしか使用したことが無く、ふわっとしたところまでしか理解できておりませんで、
さまざまなご指導頂きありがとうございます。
行いたい動作の中で疑問なのが、
With Application.FileDialog(msoFileDialogFolderPicker)をすることで、
フォルダを選択して、
A = .SelectedItems(1)でフォルダ内のテキストデータはAというフォルダの中に格納
されているということになるのでしょうか?
そしてそのAのファイルの中に格納されたテキストデータから、
さまざまな必要なデータを取得できるというコードに出来ているのでしょうか。
それとも、FileSearchオブジェクトの代替と言われるようなものを新たに加えて、
Aというファイルに入れなければいけないのでしょうか。
ふわっとしか理解が出来ていない中、業務で作成しなければいけないため、再度ご指導のほど
よろしくお願いいたします。

【78800】Re:VBAに行き詰りました。助けてください...
発言  β  - 17/2/3(金) 10:50 -

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

テキストファイルの読み込みを行うには様々な方法があります。
お使いのVBA標準IOのコードでもいいですし、あるいは エクセルブックとして開くという方法もあります。
(テキストファイルがタブ区切りのファイルであれば、列が分かれて取り込まれますのでコードが簡単になります)
また、データタブの外部データの取り込み機能をVBAで実行する方法もあります。

しかし、いずれの方法であっても、そのファイルを開くなり取り込むなりしなければいけません。

アップされたコードの Application.FileDialog(msoFileDialogFolderPicker)
これは、あくまでフォルダを選択します。ですので SelectedItems(1) は、あくまで
フォルダのフルパス文字列です。
実際には、このフォルダ内に、目的のファイルが1つ、または複数存在するわけですから
フォルダ選択後、そのフォルダ内の目的のファイルを抽出する必要があります。
アップされたコードでは、その部分がないですね。

基本的な構文としては、抽出したいファイル、あるいはそれが格納されているフォルダが
どのようなものかによって、それぞれのケースでふさわしい構成にする必要があります。

●フォルダ

フォルダが固定ではない場合は、お使いのフォルダ選択ダイアログ等で、操作者にフォルダを選択させます。
もし、フォルダが固定なら、選択させるまでもなく、たとえば "c:\Test" といったようにコード内でセット
することができますね。

●ファイル

そのフォルダ内に該当のファイルが、いくつ、どんな名前で存在するかわからない場合は
Dir関数やFSOを使って、そのフォルダ内の該当のファイルを順繰りに取り出し、それを 方法はコメントした通り
いろいろありますが、開くなり取り込むなり、開いた場合は処理後閉じる。こういうことが必要です。

もし、ファイル名が固定なら、直接 フォルダパスとファイル名を与えて処理すればよろしいですね。
(フォルダ名もファイル名も固定なら、もちろん、最初から、そのファイルを処理します)

●最初からファイル選択ダイアログを出し、操作者に1つ あるいは 複数のファイルを選択させて
 それを相手にする方法もあります。

★少しわかりにくかったでしょうか。
 上記の中で、りりさんのケースがどれに当てはまるかによって、コード構成が変わってきます。
 ですから、現行のコードを、こうこう手直しをしましょうという段階には、まだ至っていません。
 何をどのように選択したいのか、選択したものをエクセルブックのシートのどこに どのように
 書きこみたいのか、そういった要件を『文章』で説明いただけますか?
 (レイアウトも含めて、できるだけ具体的に)
 そうすれば、回答者側からは、様々なアドバイスが可能になりますので。



【78801】Re:VBAに行き詰りました。助けてください...
質問  りり  - 17/2/3(金) 11:23 -

引用なし
パスワード
   β 様
ご丁寧にご説明くださりありがとうございます。
しかし仰られた内容が確実に理解できていないため、テキストとインターネットで改めて
用語の1つ1つを理解しようと思います。

行いたい業務としては、

1.エクセル(VBA)を開く
2.A1行に作ったボタンを押す
3.Cドライブの中から参照したいフォルダを選択し、
C→作業中フォルダ→1〜10のフォルダを選択する→案件フォルダ・完了フォルダを選択→テキストデータフォルダを
選択する。
(※テキストデータフォルダには50個以上のテキストデータが入っています。)

そのテキストデータフォルダの中にある
テキストの情報をVBAで読み込んだ上で、エクセル上の
B3のセルから下へ記載するのは、ファイル名(例:2017.02.03.txt)
C3のセルから下へ記載するのは、ファイル種別(必ずTXT ファイルになります)
D3のセルから下へ記載するのは、文字数(各ファイル内に記載された全文字数)
E3のセルから下へ記載するのは、半角の文字有無(D3は基本オール全角で記載されているが、まれに半角が混じるため)

を行いたくて、
まずインターネットで、フォルダーかたファイル一覧を取得する。為の記述方法を探し、
1行ずつ言葉の意味を調べながら作成しました。
その後、半角かどうか調べるためのソースもインターネットで検索し同じく、
1行ずつ言葉の意味を調べながら作成しました。

初心者で今このレベルを行うことが無謀だと思いますが、仕事で作成をしなければならなくなり
作成しているのですが、まったくの未経験でさまざまなコードを入れたり足したりしていると、
混乱してしまい。今ではどう作業していいのかがわからず途方に暮れております。

その中で、インターネットで見つけたFILESEARCHというものを使用してみようと思ったのですが、
どう入れていいのか、2007年で終了しているがどうすればいいのか。
まず根本、FILESEARCH的なものをいれたら、希望通りに動くのか???と混乱しております。

説明もへたくそで大変ご迷惑をおかけいたしますが、お力添えください。
どうしたらいいのでしょうか・・・。

私も今後も勉強を頑張り、先生方のようなレベルになれるよう努力致します。

【78802】Re:VBAに行き詰りました。助けてください...
質問  りり  - 17/2/3(金) 13:15 -

引用なし
パスワード
   β 様

追記いたします。

各フォルダごとに収納している各テキストファイル(50個ほど)の抽出したい部分は以下のようになっています。
---------------------------------------------------------------------------
・テキスト名:aaa.txt
・テキストの内容:あいうえおあいうえお
 ・テキスト種別:TXTファイル
・文字数:10文字
・半角有無:無し
---------------------------------------------------------------------------
・テキスト名:bbb.txt
・テキストの内容:あいうえお0いうえお
 ・テキスト種別:TXTファイル
・文字数:10文字
・半角有無:有り

といったテキストファイルが続きます。
---------------------------------------------------------------------------
エクセルでの表示は
    A     B      C       D     E
1 VBAのボタン    ファイル名    ファイル種別    文字数 半角文字の有無
2          aaa.txt     TXTファイル   10      無し
3          bbb.txt     TXTファイル   10      有り
               ・
               ・
---------------------------------------------------------------------------
となりVBAのボタンを押すとユーザーで各階層を指定して、たくさんのテキストファイルのあるフォルダまで
選択したら、50個ほどのデータの内容がエクセルで表示されるようにしたいのです。

お力添え下さい。何卒宜しくお願いいたします。

【78803】Re:VBAに行き詰りました。助けてください...
発言  β  - 17/2/3(金) 23:38 -

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

了解です。
サンプルを書いてみますので少し時間ください。

【78804】Re:VBAに行き詰りました。助けてください...
発言  β  - 17/2/4(土) 0:42 -

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

とりあえず書いてみました。

Sub Sample()
  Dim fso As Object
  Dim txt As Object
  Dim buf As String
  Dim fle As Object
  Dim i As Long
  Dim fPath As String
  Dim ext As String
  Dim shT As Worksheet
  
  With Application.FileDialog(msoFileDialogFolderPicker)
    If Not .Show Then Exit Sub 'キャンセルボタン
    fPath = .SelectedItems(1)  '選択されたフォルダパス文字列
  End With
  
  Application.ScreenUpdating = False '画面の更新を抑止する
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  Set shT = ThisWorkbook.Sheets("Sheet1")
  
  shT.UsedRange.ClearContents
    
  With shT.Range("B2:E2")  '見出しを付ける
    .Value = Array("ファイル名", "ファイル種別", "文字数", "半角の有無")
    .Interior.Color = vbBlack
    .Font.Color = vbWhite
    .HorizontalAlignment = xlCenter  'セルの中の文を中央揃えにする
  End With
  
  i = 3  '記入示開始行
  
  For Each fle In fso.GetFolder(fPath).Files '指定フォルダ内のファイルを抽出
    ext = fso.GetExtensionName(fle.Name)  '拡張子
    If LCase(ext) = "txt" Then  'txtファイルのみを対象
      With fso.OpenTextFile(Filename:=fle.Path, IOMode:=1) '1:ForReading
        buf = .ReadAll '全体を一括読みこみ
        buf = Replace(Replace(buf, vbLf, ""), vbCr, "") '改行コードを削除
        shT.Cells(i, "B").Value = fso.GetBaseName(fle.Name)   '拡張子を除いたファイル名
        shT.Cells(i, "C").Value = ext
        shT.Cells(i, "D").Value = Len(buf)
        shT.Cells(i, "E").Value = IIf(Len(buf) * 2 <> LenB(StrConv(buf, vbFromUnicode)), "有", "無")
        .Close     'テキストファイルを閉じる
        i = i + 1    '次の記入行
      End With
    End If
  Next
    
End Sub

【78805】Re:VBAに行き詰りました。助けてください...
お礼  りり  - 17/2/4(土) 14:27 -

引用なし
パスワード
   β様
返事とお礼が遅くなり申し訳ございません。
・β様の作成されたものと私のもので何が変わったのか
・まだわからないコードの意味を1つ1つ調べる
・どういう流れで動いていくのか
を1つ1つ確認し、調べて、勉強致しておりました。

本当にありがとうございます。
今後、より勉強を重ね努力致します。

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