Excel VBA質問箱 IV

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

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


44 / 12976 ツリー ←次へ | 前へ→

【78796】VBAに行き詰りました。助けてください。 りり 17/2/2(木) 14:52 質問[未読]
【78797】Re:VBAに行き詰りました。助けてください。 β 17/2/2(木) 18:13 発言[未読]
【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 お礼[未読]

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

引用なし
パスワード
   始めまして、りりと申します。
VBAの初心者(1週間ほど)です。
現在、VBAを使用し、ユーザーがフォルダを選択して、そのフォルダの中にあるテキストデータ(基本的に全角の数字、漢字、ひらがな、カタカナ、アルファベット
)が書かれたフォルダの内容を抽出し、1.フォルダ名2.フォルダの種類(テキストファイル)3.各テキストファイルの中身の文字数4.各テキストファイルの中身に半角の文字や数字。アルファベットがないかを
確認出来るようにしたいと考え、下記を作成致しましたが、一向に動かず、1つ1つの文章にメモを付けて確認しましたが、動かず行き詰ってしまった為、修正をしていただけませんでしょうか。
何をどのように修正したのか、何がダメなのか(多々あると思われます)をお教えいただき、ソースもお教えいただけらば幸いです。
宜しくお願いいたします。
※謎のソースがあるかもしれませんが、行いたいのは上記の内容です。


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を作成。

Application.FileDialog(msoFileDialogFolderPicker).SelectedItems
Set A = .SelectedItems

 If .Show = True Then ' もしも正解でだったら'
Aという名前の箱に格納する。
Else ' でもそのデータがなかったら
Exit Sub ' Sub行われているプログラム内で繰り返し出現する処理をやめます。
End If 'if〜End Ifの終わり
End With 'With〜End Withステートメントの終わり

Application.ScreenUpdating = False '画面の更新がオフになったら
Set Chiba1 = CreateObject("Scripting.FileSystemObject") 'オブジェクトを作成する関数
With ThisWorkbook.Sheets("Sheet1")
  .UsedRange.Delete
    With .Range("B2:E2") '見出しを付ける
    .Value = Array("ファイル名", "ファイル種別", "文字数", "半角の有無") '見出しの文字を設定する
    .Interior.Color = RGB(0, 0, 0) '見出しの背景色を黒に設定する
    .Font.Color = RGB(255, 255, 255) '見出しの文字色を白に設定する
    .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プロシージャ終わり

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

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

う〜ん・・・

つっこみどころ満載のコードなので・・・

逆に1週間で勉強して、これだけのコードを組み立てられたのだとしたら、そうれはすごいことですが
もしかしたら、ネットや参考書に記載されていたコードを、自分流に、あれこれ 追加したり
組み合わせたりしただけなのかな?

やはり、基礎からしっかりと習得してからコード記述したほうがいいですし、
まぁ、習うより慣れろ ですから いきなりチャレンジも、悪いことではないですけど
その場合も、そのコードそれぞれについて しっかりと参考書などで意味を確認してから
使うべきですね。

まず、対になるコード という基本がVBA(だけではないのですが)にはあります。

With と End With 、If と End If 、Do と Loop、For と Next といったようyなものです。

With だけしかないとか、End With だけしかない というものは NGです。

次に、 .hoge と書きます。..SelectedItems とか .Show とか。
これは、非常に便利な記述方法なのでよく用いられますが、これを書く場合は、

With なんとか
  ここに .hoge とかく
End With

このように With句に挟まれた場所でのみ記述可能です。

なんとか『の』とか、なんとか『を』といったように指定ができます。

でも、先行して With がなければ コンパイラーから叱られます。

それと、少し難しいかもしれませんが

Application.FileDialog(msoFileDialogFolderPicker).SelectedItems


Application.FileDialog(msoFileDialogFolderPicker) はフォルダ選択ダイアログを
表示します。 
で戻り値として 様々な選択情報(含むキャンセルボタンによる無選択)を返します。

そうすると、Application.FileDialog(msoFileDialogFolderPicker).SelectedItems
というコードは そのダイアログで選択された結果の情報 ということになります。

VBAでは 何か を どうする という記述が必要です。
何か だけを ぽつんと書くと、コンパイラーから叱られます。

たとえば Range("A1").Value = "Hello" と書けますね。
でも Range("A1").Value だけのコードを書くと、これはおかしいぞ! ということになります。
それと同じです。

なずは、このあたりから、コードを手直しして、それでもだめならSOSを出してください。

【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つ確認し、調べて、勉強致しておりました。

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

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