エクセルVBA→シート名でCSV出力する際、シートの文字列はそのままで、CSVでは文字を置き換えて出

エクセルVBA→シート名でCSV出力する際、シートの文字列はそのままで、CSVでは文字を置き換えて出力したい。
tukuehukihuki
業務でCSV出力ができるマクロの作成を頼まれました。
ネットで参考にしつつ、CSV出力できるところまではたどり着いたのですが、
以下2点に苦戦しております。


1.シート名でCSVファイルを作りたい。
→現在ブック名で作成するマクロになっており、シート名で作成できるコードがよくわかりません。

2.D列の種別の文字列を、エクセルシートの文字列はそのままで、CSVファイルでは置き換えて出力したい。

例→固形=1、生物=2、食品=3、液体=4のように、
この列だけ数字で出力したいと考えてます。

はじめての質問で不足な部分があるかと思いますが、どうかお知恵を貸してください。

No.6 回答者： ggrksdqn 回答日時： 2020/12/02 19:20

No.2です。

補足です。
種別が種別マスターから見つからない場合は、変換できなので何もしないことにしています。何かしたい場合は、該当箇所のElseに処理を書いて下さい。

＜該当箇所＞
'見つかれば、種別を種別コードで置き換える
If getMatchedItemCode(itemTypeMaster, srcTable(r, convCol), itemTypeCode) Then
srcTable(r, convCol) = itemTypeCode
Else
'見つからなければ...

End If

No.5 回答者： ggrksdqn 回答日時： 2020/12/02 19:17

No.2です。

種別マスター用シートが同じブック内にある、
という前提で作り変えました。

シート名、出力先フォルダの名前等は適宜、冒頭の定数を変更して下さい｡

＜参考コード＞
'************************************
'定数
'標準モジュールに書く
'************************************

'出力元テーブルの名前
Public Const SRC_TABLE_NAME As String = "シート1"

'出力元テーブルの基準セル(ヘッダーとデータ）
Public Const SRC_TABLE_ORG_RANGE As String = "A1"

'出力元テーブルで「種別」が存在する列番号
Public Const COL_ITEMTYPE As Long = 3

'種別マスターがあるシートの名前
Public Const WSNAME_ITEMTYPE As String = "共通"

'種別マスターの基準セル（ヘッダー除く、データだけ）
Public Const ITEMTYPE_TABLE_ORG_RANGE As String = "A2"

'出力先フォルダのパス
Public Const OUT_FOLDER_PATH As String = "D:"


'************************************
'メイン
'標準モジュールか、シートモジュールに書く
'************************************
Sub Sample()

'出力元シートをセット
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(SRC_TABLE_NAME)

'出力元テーブルをセット
Dim srcTable As Variant: srcTable = _
ws.Range(SRC_TABLE_ORG_RANGE).End(xlToRight).CurrentRegion

'種別マスターをセット
Dim itemTypeMaster
If getItemTypeMaster(itemTypeMaster) = False Then
MsgBox "種別マスター 「" & WSNAME_ITEMTYPE & "」が見つかりません"
Exit Sub
End If

'出力元テーブルの「種別」を種別コードに変換して出力用テーブルにする
Dim outTable: outTable = convTable(srcTable, itemTypeMaster, COL_ITEMTYPE)

'出力用テーブルをCSVファイルに出力する
Call exportTableToCSV(outTable, OUT_FOLDER_PATH & "\" & ws.Name & ".csv")

End Sub

'************************************
'出力元テーブルの「種別」を種別コードに変換する
'引数1: 出力元テーブル
'引数2: 種別マスター
'引数3: 種別名が入った列の番号
'************************************
Public Function convTable(srcTable, itemTypeMaster, convCol As Long)

Dim r As Long
'列の数だけ繰り返す
For r = 1 To UBound(srcTable, 1)

'種別を元に、種別コードを探す
Dim itemTypeCode As String

'見つかれば、種別を種別コードで置き換える
If getMatchedItemCode(itemTypeMaster, srcTable(r, convCol), itemTypeCode) Then
srcTable(r, convCol) = itemTypeCode
Else
'見つからなければ...

End If

Next

convTable = srcTable

End Function
'************************************
'種別マスターを変数に入れる
'引数1: 種別マスターを入れて返す変数
'************************************
Public Function getItemTypeMaster(itemTypeMaster) As Boolean

On Error GoTo errorhandler
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(WSNAME_ITEMTYPE)

itemTypeMaster = ws.Range(ITEMTYPE_TABLE_ORG_RANGE).CurrentRegion
getItemTypeMaster = True
Exit Function

errorhandler:
'種別マスターシートが見つからなければ False

End Function

'************************************
'種別を受け取って、該当する種別コードを変数に入れる
'引数1: 種別マスター
'引数2: 検索する「種別」
'引数3: 該当する種別コードを入れて返す変数
'************************************
Public Function getMatchedItemCode(itemTypeMaster, itemTypeName, itemTypeCode As String) As Boolean
Dim r As Long
For r = 1 To UBound(itemTypeMaster, 1)
If itemTypeMaster(r, 1) = itemTypeName Then
itemTypeCode = itemTypeMaster(r, 2)
getMatchedItemCode = True
End If
Next
End Function
'************************************
'CSVファイルに出力
'引数1: Variant型(2次元配列)
'引数2: CSVファイルのパス
'************************************
Public Sub exportTableToCSV(tbl, path As String)
Dim ff As Integer: ff = FreeFile
Open path For Output As #ff

Dim r As Long, c As Long
For r = LBound(tbl, 1) To UBound(tbl, 1)
Dim line_ As String
For c = LBound(tbl, 2) To UBound(tbl, 2)
line_ = line_ & tbl(r, c) & ","
Next
Print #ff, Left(line_, Len(line_) - 1)
line_ = ""
Next
Close #ff
End Sub

この回答へのお礼

ggrksdqnさん
すごいです！こんなに親身にコードいただけると思ってなかったです・・感動・・
わかりやすく解説までありがとうございます。
引数や変数の書き方からも考えてくださったのが伝わります。
もっとメインコードは長くなると思っていたのですが、
こんなにさっぱりなるものなのですね・・！
こちらも参考にさせていただきます。
貴重なお知恵をありがとうございました！！

お礼日時：2020/12/03 09:40

No.4 ベストアンサー 回答者： fujillin 回答日時： 2020/12/02 10:11

No1です。

1）に相当する内容の回答は既に出ているようなので、2）の方法の例です。

※ 文字の置き換えがどの程度あるのか不明なので、ひとまずベタに記述してあります。
　 D列の文字を置き換えているだけですので、内容を変えたり、他の方法で置き換えるなど、適宜修正願います。
※ 新規ブックを作成していますので、若干画面がチラつく可能性があります。
　 動作を確認したら、「Application.ScreenUpdating = False」などを用いて、チラつきを排除するほうが良いでしょう。
※ 既に同名のブックが存在していないかというような、各種のチェックは省いています。

Sub Sample_12050447()
ActiveSheet.Copy
With ActiveSheet
　With .Columns(4)
　　.Replace "固形", 1, xlWhole
　　.Replace "生物", 2, xlWhole
　　.Replace "食品", 3, xlWhole
　　.Replace "液体", 4, xlWhole
　End With
　.SaveAs ThisWorkbook.Path & "\" & .Name, xlCSV
End With
ActiveWorkbook.Close False
End Sub

この回答へのお礼

再度のご回答ありがとうございます！
文字の置換は５つ程度にとどまったこともあり、べた書きでも問題なさそうでした。

こちらのコードを拝借して、自分なりにあれこれコード追加して思い通りのものができました！
こんなにさっぱりしたコードでできると思わず、感動しました。
該当のシートに置換出力処理をしたうえで、
色んなシートにもCSV出力できるよう対応できたので、私の知識でも応用がきいて助かりました。
解決案を出してくださったので、
今回はfujillinさんをベストアンサーとさせていただきます。

本当にありがとうございました！

お礼日時：2020/12/03 09:43

No.3 回答者： ggrksdqn 回答日時： 2020/12/01 12:39

No.2 種別とコードの組み合わせは変更等に対応しやすくするために、独立したシートにマスターとして管理するのが普通ですが、そのような要件がなかったので、コード内に直に入力しています。

種別の件数が少なく、配列にするのも面倒だったので、カンマとセミコロンで区切った文字列で対応しました。保守性を求めるならこの部分は変えた方がいいです。

この回答へのお礼

ggrksdqnさん、お早い回答、丁寧にコードまで、
意図をくみ取っていただき大変ありがたいです！
お返事が遅くなってしまい申し訳ありません。

回答を拝見して、確かにマスタシートを作成したほうがいいな、と思い
ローカルでブックをコピーし、
試しにシートを作って、対応表を作ってみました。
------------------------シート名：共通
A列　　　B列
固形　　　1
液体　　　2
食品　　　3
生もの　　4
----------------------
↑このような感じです。

重ねて教えていただきたいのですが、このように対応表を作った場合は、
どのようにVBAに組み込めばよいでしょうか。。

（先にNO.2で回答いただいたマクロを拝借して、動作確認しました！ありがとうございます。）

お礼日時：2020/12/02 10:45

No.2 回答者： ggrksdqn 回答日時： 2020/12/01 12:29

Sub Sample()

'種別とコードの対応表（"種別,コード"の組み合わせを ;　で区切る）
Dim mst As String: mst = "固形,1;液体,2;食品,3;生もの,4"

'シート名をセット
Dim wsName As String: wsName = ActiveSheet.Name

'出力するデータをセット
Dim dat: dat = getTable(Sheets(wsName), mst, 3)

'データをCSVファイルに出力する
Call TableToCSV(dat, ThisWorkbook.path & "\" & wsName & ".csv")

End Sub

'************************************
'シートからテーブルを抽出してVariant型(2次元配列)データにして返す
'指定した列のデータを指定した文字列に変換する
'引数1: 対象のワークシート
'引数2: 変換表
'引数3: 変換の対象になる列
'************************************
Public Function getTable(ws As Worksheet, convTbl As String, convCol As Long)

Dim v: v = ws.Cells(1, 1).End(xlToRight).CurrentRegion

Dim r As Long, c As Long
For c = 1 To UBound(v, 2)
For r = 1 To UBound(v, 1)
If c = convCol Then
Dim tbl: tbl = Split(convTbl, ";")
Dim i As Long
For i = LBound(tbl) To UBound(tbl)
Dim line_: line_ = Split(tbl(i), ",")
Dim itm As String: itm = line_(0)
Dim id As String: id = line_(1)

If v(r, c) = itm Then
v(r, c) = id
End If
itm = "": id = ""
Next

End If
Next
Next

getTable = v

End Function

'************************************
'CSVファイルに出力
'引数1: Variant型(2次元配列)
'引数2: CSVファイルのパス
'************************************
Public Sub TableToCSV(tbl, path As String)
Dim ff As Integer: ff = FreeFile
Open path For Output As #ff

Dim r As Long, c As Long
For r = LBound(tbl, 1) To UBound(tbl, 1)
For c = LBound(tbl, 2) To UBound(tbl, 2)
Print #ff, tbl(r, c) & ",";
Next
Print #ff, vbCrLf;
Next
Close #ff
End Sub

No.1 回答者： fujillin 回答日時： 2020/12/01 10:36

こんにちは

現在どのような方法で書き出していらっしゃるのかがわかりませんが、普通に考えられるのは大きく分けて二通りの方法でしょうか。


1）VBAで各行をCSV化して、テキストファイルとして出力する。
https://tonari-it.com/vba-write-csv/
https://www.tipsfound.com/vba/18016
このような方法の場合は、テキスト出力前に文字列の置き換えを行えば良いでしょう。

＞シート名で作成できるコードがよくわかりません。
出力先のファイル名指定が、Workbook.Nameなどとなっているものを、Worksheets("対象シート").Nameに変えれば良いです。


2）エクセルの保存機能を利用して、CSVを作成。
（こちらの方法であれば、8割程度は「マクロの記録」などで作成可能です。）
・対象のシートを単独の（新しい）ブックにします。
　　対象シート.Copy
・上記を実行すると、単独シートのブックがコピー作成されますので、このブック（シート）上で文字の置き換えを行ってしまえば良いです。
・あとは、「名前を付けて保存」でCSVファイルとして出力すれば終了ですね。

※ 保存時のファイル名を、「対象シート.Name」にするところは1）と同様です。

この回答へのお礼

こんにちは。こんなに早く回答をもらえると思っていませんでした。
お返事が遅くなり申し訳ありません。感謝申し上げます。

CSVを出力するコードは、
https://www.excelspeedup.com/csvsyuturyoku/
こちらでダウンロードしたものを使用していました。
ただ、思っていたよりしっかりしたソースコードなので、
私の知識ではメンテナンスや手入れが難しく感じていたところです。
（知識不足ゆえに活用しきれない悲しさ；；）

Fujillinさんが1）で回答くださった
https://tonari-it.com/vba-write-csv/
こちらでなら私でも理解しやすいと思いました。ありがとうございます。

私的には　2）で記述されている、コピーをしてその上で置換する方法を参考にしたいと思います。
大変有益な情報をありがとうございます！

お礼日時：2020/12/02 10:44