| |
始めまして、りりと申します。
VBAの初心者（１週間ほど）です。
現在、VBAを使用し、ユーザーがフォルダを選択して、そのフォルダの中にあるテキストデータ（基本的に全角の数字、漢字、ひらがな、カタカナ、アルファベット
）が書かれたフォルダの内容を抽出し、1.フォルダ名2.フォルダの種類（テキストファイル）3.各テキストファイルの中身の文字数4.各テキストファイルの中身に半角の文字や数字。アルファベットがないかを
確認出来るようにしたいと考え、下記を作成致しましたが、一向に動かず、１つ１つの文章にメモを付けて確認しましたが、動かず行き詰ってしまった為、修正をしていただけませんでしょうか。
何をどのように修正したのか、何がダメなのか（多々あると思われます）をお教えいただき、ソースもお教えいただけらば幸いです。
宜しくお願いいたします。
※謎のソースがあるかもしれませんが、行いたいのは上記の内容です。
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にする（列が３段下がる）
.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(木) 14:52 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
≪
