エクセルマクロ(VBA)超初心者です。
エクセルシート内の3か所の指定範囲内の複数セル内の文字列をtxt形式でぞれぞれ3つのtxtファイル書き出して保存したいのですが、どのような記述がよろしいでしょうか。
------------------------------------
A B C
1 <範囲1>
2 aa bb cc
3 dd ee ff
4 <範囲2>
5 gg hh ii
6 jj kk ll
7 mm nn oo
8 <範囲3>
9 pp qq rr
10 ss tt uu
11 vv ww xx
12 yy zz aa
------------------------------------
要望
(1)指定範囲は3か所で、セルの場所は不変。
<範囲1>はA2~C3
<範囲2>はA5~C7
<範囲3>はA9~C12
(2)書き出されたtxtは改行削除、タブ削除がなされた状態にする。
<範囲1>はaabbccddeeff
<範囲2>はgghhiijjkkllmmnnoo
<範囲3>はppqqrrssttuuvvwwxxyyzzaa
(3)保存する.txtファイルは常に固定のファイル名でそれぞれ保存。
<範囲1>はD:\hogehoge\1.txt
<範囲2>はD:\hogehoge\2.txt
<範囲3>はD:\hogehoge\3.txt
※セル内の文字列は他のシートのデータを参照しエクセル関数によって
導かれたものです。
この文字列の内容は毎回変わります。
他のシートのデータを更新したあと、一度の処理実行で上記3ファイルが
書き出されることで業務を効率化させたいと考えています。
この業務はほぼ毎日のように発生する繰り返し業務のため、
エクセルマクロ(VBA)による効果は大きいと思います。
No.2ベストアンサー
- 回答日時:
こんにちは。
>それぞれマクロ内に事前に記述した任意のファイル名を付けるように
>したい場合はどうすればいいでしょうか。
ある程度は、想定していました。簡単に直すとこのようになります。
一応、もう一つの想定事項を書いておくと、上書きではなく「追加の書き込み」ということでした。ふだん、私は、今回のようなマクロにしないのですが、気になったので、そういうコードにしました。
本題に戻りますと、
Fnames = Array("abc", "def", "xyz") 'ここに拡張子なしでファイル名を書き込みます。
修正点は2つです。
なお、念の為に書いておきますと、
ar = Array(Range("A2:C3"), Range("A5:C7"), Range("A9:C12"))
こちらのセルの範囲が3つなって、3回分のファイルが作られますから、ファイル名は3つないといけません。4つにするためには、ファイル名も当然、4つがないといけません。
もう一つ、念のためですが、出力は、SJISになっていますが、オプションを加えることで、UNICODEの変更も可能です。
'//
Sub ExportTextR()
'No. 9054919
Dim objFS As Object
Dim objFolder As Object
Dim objFile As Object
Dim buf As String
Dim c As Variant, i As Long
Dim ar As Variant
Dim Fnames As Variant
'----設定----
Const MYPATH = "D:\hogehoge\" '末尾には、¥を入れてください。
'A2~C3,A5~C7,A9~C12
ar = Array(Range("A2:C3"), Range("A5:C7"), Range("A9:C12"))
'出力ファイル名
Fnames = Array("abc", "def", "xyz") '←修正点(ここにファイル名を書き込む)
'----設定終---
Set objFS = CreateObject("Scripting.FilesystemObject")
If objFS.FolderExists(MYPATH) = False Then
MsgBox MYPATH & "というフォルダーは存在しません", vbExclamation: Exit Sub
Else
Set objFolder = objFS.GetFolder(MYPATH)
End If
For i = 0 To UBound(ar)
For Each c In ar(i)
buf = buf & c.Text 'テキストプロパティにしている
Next c
Set objFile = objFolder.CreateTextFile(Fnames(i) & ".txt") '←修正点
objFile.Write buf
buf = ""
objFile.Close
Next i
End Sub
'///
WindFallerさん
ありがとうございました。
オプションのutf-8出力のほうは当方のやり方がよくないのか、「実行時エラー'3002':ファイルを開けませんでした」のエラーが出ました。
ただし、shift-jis出力で当方は問題ないことがわかりましたのでこちらの回答にてベストアンサーとさせていただきたいと思います。
ありがとうございました。
No.4
- 回答日時:
こんにちは。
>記号、2バイト文字ともURLエンコードされない形でUTF-8出力する方法はありますでしょうか。
>こちらはVBAの守備範囲からはずれてくるかもわかりませんが。
失礼しました。記号化することかと思っていましたので、間違えました。もちろん、Web系のVBAを扱う人なら、これは守備範囲です。UTF-8変換の意図が分からなかったからです。たぶん、問題ないと思います。
一応、ツギハギで間違えるといけないので、全文を改めて出しておきます。
'//
Sub ExportTextR2()
No. 9054919-3 obj型UTF-8変換
Dim objFS As Object
Dim objFolder As Object
Dim objFile As Object
Dim buf As String
Dim c As Variant, i As Long
Dim ar As Variant
Dim Fnames As Variant
Dim fn As String
'----設定----
Const MYPATH = "D:\hogehoge\" '末尾には、¥を入れてください。
'A2~C3,A5~C7,A9~C12
ar = Array(Range("A2:C3"), Range("A5:C7"), Range("A9:C12"))
'出力ファイル名
Fnames = Array("abc", "def", "xyz")
'----設定終---
Set objFS = CreateObject("Scripting.FilesystemObject")
If objFS.FolderExists(MYPATH) = False Then
MsgBox MYPATH & "というフォルダーは存在しません", vbExclamation: Exit Sub
Else
Set objFolder = objFS.GetFolder(MYPATH)
End If
For i = 0 To UBound(ar)
For Each c In ar(i)
buf = buf & c.Text 'テキストプロパティにしている
Next c
fn = Fnames(i) & ".txt"
Set objFile = objFolder.CreateTextFile(fn)
objFile.Write buf
buf = ""
objFile.Close
Call objSJis2Utf8(fn)
Next i
End Sub
Private Sub objSJis2Utf8(Fname As String)
Dim objSrc As Object 'ADODB.Stream
Dim objDst As Object ' ADODB.Stream
Set objSrc = CreateObject("ADODB.Stream")
With objSrc
.Type = 2 ' adTypeText
.Open
.Charset = "shift-jis"
.LoadFromFile Fname
.Position = 0
End With
Set objDst = CreateObject("ADODB.Stream")
With objDst
.Type = 2
.Open
.Charset = "utf-8"
.Type = 2 'adTypeText
End With
objSrc.CopyTo objDst
objDst.Position = 0
objDst.savetofile Fname, 2
End Sub
'///
No.3
- 回答日時:
こんばんは。
コードの下から見ていって、Next c という所の後に、
buf = strEncodeUtf8(buf) 'UTF8に変換
という行を加えてあげ、エンコード用のユーザー定義関数を加えてあげればできます。
・
・
・
For i = 0 To UBound(ar)
For Each c In ar(i)
buf = buf & c.Text 'テキストプロパティにしている
Next c
buf = strEncodeUtf8(buf) 'UTF8に変換 ◎ココ
Debug.Print buf
Set objFile = objFolder.CreateTextFile(Fnames(i) & ".txt")
objFile.Write buf
buf = ""
objFile.Close
Next i
End Sub
'ユーザー定義関数
Private Function strEncodeUtf8(ByVal strSource As String) As String
Dim objSC As Object
Set objSC = CreateObject("ScriptControl")
objSC.Language = "Jscript"
strEncodeUtf8 = objSC.CodeObject.encodeURIComponent(strSource)
Set objSC = Nothing
End Function
'もし、あちこちでこの関数を使うようでしたら、Private から、Public に直してあげるとよいです。
No.1
- 回答日時:
こんにちは。
上書き更新でよいのでしょうか?
それなら、以下のようにすればよいです。都合で、全部FileSystemObject からみにしてしまいました。
出力の最後には、Enterキーが入っていませんので、もし、加工したりする場合は、vbCrLf などを最後に付け加えてやらないといけません。
'//
Sub ExportText()
Dim objFS As Object
Dim objFolder As Object
Dim objFile As Object
Dim buf As String
Dim c As Variant, i As Long
Dim ar As Variant
'----設定----
Const MYPATH = "D:\hogehoge\" '末尾には、¥を入れてください。
'A2~C3,A5~C7,A9~C12
ar = Array(Range("A2:C3"), Range("A5:C7"), Range("A9:C12"))
'----設定終---
Set objFS = CreateObject("Scripting.FilesystemObject")
If objFS.FolderExists(MYPATH) = False Then
MsgBox MYPATH & "というフォルダーは存在しません", vbExclamation: Exit Sub
Else
Set objFolder = objFS.GetFolder(MYPATH)
End If
For i = 0 To UBound(ar)
For Each c In ar(i)
buf = buf & c.Text 'テキストプロパティにしている
Next c
Set objFile = objFolder.CreateTextFile(CStr(i + 1) & ".txt")
objFile.Write buf
buf = ""
objFile.Close
Next i
End Sub
'///
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) Excelのマクロコードについて教えてください。 1 2022/03/27 13:25
- Excel(エクセル) エクセルの数式について ブック内の別シートの値の含まれたセルの個数を集計したい 全シート一覧のシート 1 2022/07/21 19:28
- Visual Basic(VBA) ExcelのVBAコードについて教えてください。 1 2023/01/23 11:02
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Excel(エクセル) 条件に合った数値の合計を表示させたい関数と条件指定の方法 3 2023/05/13 16:07
- Excel(エクセル) 【VBA】指定フォルダに格納中のテキストファイルをエクセルで処理し結果のエクセルを新規フォルダに保存 1 2022/03/25 14:19
- Visual Basic(VBA) 【VBA】Excelの特定範囲のセルを画像で保存したい 2 2023/01/25 13:06
- Excel(エクセル) 単価シートから単価をエクセル関数で自動取得する方法 1 2023/07/02 22:00
- Excel(エクセル) Excel VBA 空白行があるセル範囲に色を付ける 3 2022/06/13 15:58
- Visual Basic(VBA) Excelのマクロについて教えてください。 1 2023/03/12 12:16
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelについて質問です。 ・デ...
-
Excel2010で、今の、Ex...
-
UNIQUE関数が使えないバージョ...
-
Excelについて質問です。
-
エクセルに詳しい方教えて下さ...
-
Excelで「時間の足し算」はどう...
-
Excelについて質問です。 表の...
-
オートフィルのショートカット...
-
Excel表の文字の幅を狭くしたい
-
勤務表をエクセルで作る際、 最...
-
Excelのフォントについて
-
Excel 2019 のピボットテーブル...
-
エクセルのパスワードの一括解...
-
エクセルのソートについて
-
Excel 連番を入力する方法
-
Excel 漢字二文字の先頭と最後 ...
-
列を増やさずに、月だけの件数...
-
Excelで、10000,20000,30000と...
-
エクセルの検索関数でシート内...
-
Excel 2019 での上書き保存につ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセル詳しい方教えて下さい
-
ExcelでA列をコピーしたいので...
-
エクセルのセル統合について
-
Excelの関数で起きた現象の原因...
-
Excelファイルが閉じられい!
-
Excelのシート背景に不明な文字...
-
エクセルの枠線
-
Excel 領収書発行
-
エクセル関数の使い方を教えて...
-
C列にF列の担当者(A〜)を順番...
-
ピポットテーブルの参照元を別...
-
EXCEl VBA
-
Excelでの判別方法
-
VBAで、サブフォルダにある複数...
-
"りんご"と"みかん"というシー...
-
マクロについて教えてください。
-
EXCELファイルが読み取り専用で...
-
同一セルに入力規則のリストと...
-
100行50列の表で、1~40列でフ...
-
なぜか「Nextに対応するForがあ...
おすすめ情報
ありがとうございました。ご教示いただきました内容でまさに
希望通りの結果となりました。
ここで欲が出てきたといいますか・・・・
(3)で述べた保存する.txtファイル名ですが、1.txt、2.txt、3.txtではなく
それぞれマクロ内に事前に記述した任意のファイル名を付けるように
したい場合はどうすればいいでしょうか。
例
<範囲1>はD:\hogehoge\abc.txt '任意のファイル名
<範囲2>はD:\hogehoge\def.txt '任意のファイル名
<範囲3>はD:\hogehoge\xyz.txt '任意のファイル名
WindFallerさん、ありがとうございました。
うまくいきました。
> 一応、もう一つの想定事項を書いておくと、上書きではなく「追加の書き込み」
> ということでした。
当方の要望は上書き更新ですのでいただいた記述で適合です。
> もう一つ、念のためですが、出力は、SJISになっていますが、オプションを加え
> ることで、UNICODEの変更も可能です。
ご指摘ありがとうございました。こちらの事項は思いつきませんでした。
要望はutf-8出力です。
書き出した後にフリーソフト等で変換してもいいかとは思いますが、
こちらも1度の実行でurf-8書き出しまで完了できるとありがたいです。
オプションを加える場合の記述方法ご教示いただけますでしょうか。
(当方の「要求仕様」が不十分で2度手間3度手間かけてしまいまして
すみません。これができましたら要望通りです。)
WindFallerさん、ありがとうございました。
(1)2回目の回答でお示しいただきました「For i = 0 To UBound(ar)」以下を
差し替えてみました。
書き出されたtxtファイルを文字コード判定ツールで見てみたところ
shift-jisの判定でした。
(2)また、記号、2バイト文字(漢字等)がURLエンコードされた文字で出力されます。
●出力したい文字(抜粋)
document.write('<dd class
↓
●実際に出力された文字(抜粋)(URLエンコードされた文字となっています)
document.write('%3Cdd%20class
記号、2バイト文字ともURLエンコードされない形でUTF-8出力する方法はありますでしょうか。
何度もすみません。(こちらはVBAの守備範囲からはずれてくるかもわかりませんが。)