Excel VBA質問箱 IV

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

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


475 / 73642 ←次へ | 前へ→

【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プロシージャ終わり

106 hits

【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 お礼[未読]

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