今回からは実際にプログラムを書いていきます。
前 ＞ 【社内DX案件紹介】アンケートの集計-１-
今回作るマクロ
前回までのおさらいですが、今回の依頼内容は
「特定のフォルダにあるアンケートをデータベースに登録するフォーマットに変換するマクロを組んでもらいたい。」
というものになります。
前回までは作るべきマクロの処理内容までやりましたが、
１．CSVファイルを検索
２．ファイル名を取得
３．CSVファイルを開く
４．情報を取得
５．情報を転記（今回はマクロファイルの別シート「出力先」へ転記する）
まずは１．ファイルを検索と２．ファイル名を取得（Sub File_Kensaku()）
'/--「特定のフォルダ」のフォルダパス--/'
Dim strFolder_Path As String
'/--検索されたcsvファイルのファイル名--/'
Dim strFile_Name As String
'/--シート「出力先」の最終行--/'
Dim lngMax_Row As Long
Sub File_Kensaku()
'/--CSVファイルが入っているフォルダのパス--/'
strFolder_Path = "C:\temp"
'/--転記先（シート「出力先」）の最終行を数える--/'
lngMax_Row = Sheets("出力先").Range("A1048576").End(xlUp).Row
'/--画面の更新を止める--/'
Application.ScreenUpdating = False
'/--１．CSVファイルを検索 --/'
'/--フォルダ「Folder_Path」内にあるcsvファイルを検索--/'
strFile_Name = Dir(strFolder_Path & "\*.csv")
'/--フォルダ内にファイルが無い（File_Nameのサイズが0）のときは終了--/'
If Len(strFile_Name) = 0 Then
Exit Sub
End If
'/--２．ファイル名を取得 --/'
'/--検索されたファイルが無い（File_Nameのサイズが0）状態になるまでループ--/'
Do Until Len(strFile_Name) = 0
'/--ファイルを開く処理（CSV_Hiraku）を呼び出し--/'
Call CSV_Hiraku
'/--次のファイルを検索--/'
strFile_Name = Dir()
Loop
'/--画面の更新を開始する--/'
Application.ScreenUpdating = True
End Sub
それぞれの細かい式は多分調べれば出てくるので、ここでは簡単な解説だけ。
strFile_Name = Dir(strFolder_Path & "\*.csv")
こちらでまず１発目にstrFolder_Path（C:\temp）内にあるCSVファイルを検索します。
もしファイルがあれば、strFile_Nameにファイル名が入ります。
If Len(strFile_Name) = 0 Then
で、ひょっとしたらC:\temp内にCSVファイルが1つも無いかもしれないので、ファイルが無かったらExit Subで終了にしています。
If strFile_Name = ”” Thenでも良いと思うのですが、strFile_Name = NULLの時を想定してIf Len(strFile_Name) = 0 Then（strFile_Nameの中身の文字数が0）で作っています。
Do Until Len(strFile_Name) = 0
strFile_Nameに値が入っている間はループするようにしています。
Call CSV_Hiraku
２．ファイルを開く処理（CSV_Hiraku）を呼び出します。
CSV_Hirakuが終わると、また戻ってきます。
strFile_Name = Dir()
ここがファイル検索の肝の部分だと思います。
上では
Dir(strFolder_Path & "\*.csv")
と書いていましたが、今回は
Dir()
と括弧の中身が入っていない状態です。
この違いは
Dir(strFolder_Path & "\*.csv") ・・・ 最初から検索（過去検索されたものも含む）
Dir() ・・・ 次を検索（過去検索されたものは除外）
となります。
strFile_Name = Dir()を繰り返すと次へ…次へ…となり、フォルダ内のCSVファイルが全て検索されることになります。
なので最終的には
Len(File_Name) = 0
となり、
Do Until Len(strFile_Name) = 0
のループを抜けることになります。
続いて、３．CSVファイルを開く～５．情報を転記（Sub CSV_Hiraku()）
Sub CSV_Hiraku()
'/--開くCSVファイルパス--/'
Dim strHiraku_CSV As String
'/--CSVファイルの１行分データ--/'
Dim strGyo_Data As String
'/--strGyo_Dataの配列格納用データ--/'
Dim valHairetsu
'/--valHairetsuの要素数（CSVの列数）--/'
Dim intRetsu As Integer
'/--会社名--/'
Dim strKaisha As String
'/--販売会社--/'
Dim strHanbai As String
'/--国外--/'
Dim strKokugai As String
'/--国内--/'
Dim strKokunai As String
'/--所見--/'
Dim strShoken As String
'/--intRetsuの周回用カウンタ--/'
Dim x As Integer
'/--シート「出力先」の書き込み行--/'
Dim y As Long
'/--検索されたCSVのフルパス--/'
strHiraku_CSV = strFolder_Path & "\ " & strFile_Name
'/--yに最終行を入れる--/'
y = lngMax_Row
'/--３．CSVファイルを開く--/'
'/--CSVファイルをテキスト形式でNo1で開く--/'
Open strHiraku_CSV For Input As #1
'/--とりあえず１行読み込む（カラム名の部分）--/'
Line Input #1, strGyo_Data
'/--CSVファイルが最終行になるまでループ--/'
Do Until EOF(1)
'/--４．情報を取得--/'
'/--変数を初期化--/'
strKaisha = ""
strHanbai = ""
strKokugai = ""
strKokunai = ""
strShoken = ""
x = 0
'/--1行読み込む--/'
Line Input #1, strGyo_Data
'/--読み込んだ1行を配列に格納する--/'
valHairetsu = Split(strGyo_Data, ",")
'/--配列の要素数（CSVの列数）を取得する--/'
intRetsu = UBound(valHairetsu)
'/--配列の要素数（CSVの列数）分、周回する--/'
For x = 0 To intRetsu
Select Case x
'/--valHairetsu(0)（会社名）のとき--/'
Case 0
strKaisha = strKaisha & valHairetsu(x)
'/--valHairetsu(1～4)（販売会社）のとき--/'
Case Is <= 4
If Len(strHanbai) <> 0 Then
strHanbai = strHanbai & vbCrLf
End If
strHanbai = strHanbai & valHairetsu(x)
'/--valHairetsu(5～8)（国外）のとき--/'
Case Is <= 8
If Len(strKokugai) <> 0 Then
strKokugai = strKokugai & vbCrLf
End If
strKokugai = strKokugai & valHairetsu(x)
'/--valHairetsu(9～12)（国内）のとき--/'
Case Is <= 12
If Len(strKokunai) <> 0 Then
strKokunai = strKokunai & vbCrLf
End If
strKokunai = strKokunai & valHairetsu(x)
'/--valHairetsu(13～16)（所見）のとき--/'
Case Is <= 16
If Len(strShoken) <> 0 Then
strShoken = strShoken & vbCrLf
End If
strShoken = strShoken & valHairetsu(x)
End Select
Next x
'/-- ５．情報を転記 --/'
y = y + 1
Sheets("出力先").Cells(y, 1).Value = strKaisha
Sheets("出力先").Cells(y, 2).Value = strHanbai
Sheets("出力先").Cells(y, 3).Value = strKokugai
Sheets("出力先").Cells(y, 4).Value = strKokunai
Sheets("出力先").Cells(y, 5).Value = strShoken
Loop
'/--シート「出力先」の最終行を更新--/'
lngMax_Row = y
'/--CSVファイルを閉じる--/'
Close #1
End Sub
こちらについての解説
Open strHiraku_CSV For Input As #1
ここから「Close #1」までが「３．CSVファイルを開く」の部分になります。
処理としては、「開くCSVのフルパス（strHiraku_CSV）」をテキストモードで読み込んでいる。
ちなみにテキストファイルへ書き出すときはFor Output Asとなる。
#１はファイル番号1にテキストデータを読み込む。という意味。
複数のテキストファイルを開く場合（CSVファイルと読み込んで、別のCSVファイルに書き出す場合とか）は＃1の部分を別の番号（＃2とか）にすることで区別できる。
ちなみにこのファイル番号1は閉じるまでかなりの頻度で使用する。
Line Input #1, strGyo_Data
ファイル番号1（＃1）のデータを１行読み込んで、strGyo_Dataへ代入する。
CSVファイルはカンマ区切り（，）で構成されているので、この時格納されるデータは
,販売会社,販売会社,販売会社,販売会社,国外,国外,国外,国外,国内,国内,国内,国内,所見,所見,所見,所見
このようになる。
Do Until EOF(1)
ここから「Loop」までが「４．情報を取得」の部分になります。
「３．CSVファイルを開く」のように別の部分に切り出して呼び出すほうがイメージつきやすいかもしれませんが、あまり意味がないと思い中に入れました。
処理としては、
ファイル番号1（＃1）のデータが最後（最終行の次）になるまでループする。
Do Untilで～まで
EOF(End Of File)は最後（最終行の次）
EOF(この中)はファイル番号（＃１）
となる。
Hairetsu = Split(strGyo_Data, ",")
strGyo_Dataに代入された1行分のデータをカンマ（，）を区切りとし配列（valHasiretsu）に格納します。
１行分の文字列データから指定の文字（今回は","）で配列が自動生成されるので、非常に便利です。が、自分で配列のサイズを決めないので配列内をループさせるときには注意が必要です。
ちなみに↑のGyo_Data（,販売会社,販売会社,販売会社,販売会社,国外,国外,国外,国外,国内,国内,国内,国内,所見,所見,所見,所見）だったとすると、valHairetuはこんな感じになります。
valHairetsu() = {,販売会社,販売会社,販売会社,販売会社,国外,国外,国外,国外
,国内,国内,国内,国内,所見,所見,所見,所見}
ちなみに数え方は0からなので、↑のだと
valHairetsu(0) ＝ NULL
valHairetsu(1) ＝ "販売会社"
となります。
intRetsu = UBound(valHairetsu)
配列（valHairetsu）のサイズをintRetsuに代入します。
↑で少し触れましたが、Splitで配列に格納した場合、配列のサイズがわからない場合があるのでUbound(配列)でサイズを調べます。
配列は0始まりなので。Uboundで調べたサイズも0からの数になります。
For x = 0 To intRetsu
Uboundで調べた配列サイズRetsuの分周回します。
今回は表形式のデータをこんな感じで周回するイメージです。
Select Case x
今何列目か？（xの値がいくつか？）によって処理を変えています。
上から順に判定されていくので、たとえ
Case Is <= 16（ｘが16以下）
であっても、その前に
Case Is <= 12（ｘが12以下）
があるので、
Case Is <= 16
で処理される条件はxが13～16のとき（13～16列目：所見の列）のみとなります。
それぞれのCaseで変数に値を代入しています。
If Len(strHanbai) <> 0 Then
何かの手違いで元のデータシートに値が重複している（販売会社が2つの欄に記載されているとか）場合があるかもしれません。
そういった場合、
strHanbai = valHairetsu(x)
とやってしまうと、値を上書きしてしまいミスがあったことにも気づけなくなるので、
If Len(strHanbai) <> 0 Then
で値が入っているか判定し、もし値が入っていたら
strHanbai = strHanbai & vbCrLf
で改行コード（vbCrLf）を入れています。
特に「所見」の列は必ず複数値が入っているので、
【申入内容】○○○○○○○
【理由】○○○○○○○
【受付媒体】○○○○○○○
【その他】○○○○○○○
となるように、
strShoken = strShoken & vbCrLf
で必ず改行コードを入れます。
Sheets("出力先").Cells(y, 1).Value = strKaisha
ここが「５．情報を転記」の部分になります。
For x = 0 To intRetsuで周回して取得した情報を転記しています。
別ファイルに書き出してもいいのですが、今回はマクロファイル内に値を転記することで結果をわかりやすくしてみました。
以上で案件の1つ目は終了です。
次回は案件の2つ目になります。
0 件のコメント:
コメントを投稿