Excel VBA質問箱 IV

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

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


526 / 73695 ←次へ | 前へ→

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

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

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