| |
▼りり さん：
とりあえずコンパイルエラーがでないコードに修正しました。
質問箱の掲示板上の制約で、コードが（ＷＥＢ上）改行されて醜いのですが
コピペしてモジュールに貼り付けると、見やすくなるかと思います。
つけられたコメントそのものがおかしなところや、コードを変えたほうがいいところは
★をつけてなおしてあります。
コンパイラーレベルの修正ですから、ロジック自体が大丈夫かどうかの検証はしていません。
ところで、
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 は複数形です。コレクションです。その１番目。また、これは文字列情報ですから 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にする（列が３段下がる）
.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というファイル番号から１行ずつデータを読み込み、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プロシージャ終わり
|
|
β
- 17/2/2(木) 18:49 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
