人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

次の動作をするExcel(エクセル)2007のVBA(マクロ)コードを教えていただきたいです。


【Sheet2】の【A列】、【B列】、【E列】、【F列】、【G列】、【H列】、【I列】を1行ごとにセットとして、テキストファイルに出力したいです。

また、テキストファイル出力するときは
列ごとに特定の順番があり、列によっては後ろに特定の文字列をくっつける仕様になります。



(※長くなってしまったので、具体的な「続き」を、このページ下部の「コメント」欄に書かせていただきます。
よろしくおねがいします。)


●質問者: ヘンリ
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● cx20
●1000ポイント ベストアンサー

Excel VBA でなく VBScript ですがよろしいでしょうか。
(以前、似たような質問(http://q.hatena.ne.jp/1320812779)があったので、それを少し修正したものになります。)

デスクトップにフォルダを作成する機能は、眠くなってきたので未実装です。すみません。。。
出力先ファイルパスの変数(g_strOutputFile)を修正してご利用ください。

本プログラムは、ADO というライブラリを使用した Excel データアクセスのサンプルプログラムになります。
SQL をご存じであれば、Excel データを DB のようにアクセスすることが可能です。

A B C D E F G H I
001horse 180 25 60微妙な人間の表情を読み取れる
002dog 50 15 50飼い主に従順
003ゾウelephant600 55 40個体差があり、気性が荒かったり従順だったりする
010馬2 horse2 微妙な人間の表情を読み取れる

ヘッダ行が無い場合は、A列…F1、B列…F2、...、I列…F9のように扱うことができます。

' File : ExcelToReportText.vbs
' Usage : CScript //Nologo ExcelToReportText.vbs
Option Explicit

' Excelファイルを指定します
Const g_strExcelFile = "C:\home\edu\hatena\egaosaiko\1412702543\Book1.xlsx"
' 出力先のファイルパスを指定します
Const g_strOutputFile = "C:\home\edu\hatena\egaosaiko\1412702543\output\出力データ.txt"

Call Main()

Sub Main()
  ' Excel ファイルの内容を指定したパスにテキストファイル出力する
 Call ConvertExcelToReportTextFile( g_strExcelFile, g_strOutputFile )
End Sub

' Excel ファイルの内容を指定したパスにテキストファイル出力する
Sub ConvertExcelToReportTextFile( strFileName, strOutputFile )
 Dim cn
 Set cn = CreateObject("ADODB.Connection")
 
  ' Excel 97-2003 であれば、以下を有効化します。
  'cn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFileName & ";Extended Properties=""Excel 8.0;HDR=No;"""
  ' Excel 2007/2010 の場合は、以下を有効化します。
 cn.Open "PROVIDER=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFileName & ";Extended Properties=""Excel 12.0;HDR=No;"""
 
 Dim rs
  '+---+----+---+---+--------+---+---+---+----------------------------------------------+
  '| A |B |C |D |E |F |G |H |I |
  '+---+----+---+---+--------+---+---+---+----------------------------------------------+
  '|001|馬 | | |horse |180| 25| 60|微妙な人間の表情を読み取れる |
  '|002|犬 | | |dog | 50| 15| 50|飼い主に従順 |
  '|003|ゾウ| | |elephant|600| 55| 40|個体差があり、気性が荒かったり従順だったりする|
  '|010|馬2 | | |horse2 | | | |微妙な人間の表情を読み取れる |
  '+---+----+---+---+--------+---+---+---+----------------------------------------------+
  ' : : : : : : : : :
  ' F1 F2 F3 F4 F5 F6 F7 F8 F9
  '
  ' SELECT F1, F2, F5, F6, F7, F8, F9 FROM [Sheet2$]
 Set rs = cn.Execute("SELECT F1, F2, F5, F6, F7, F8, F9 FROM [Sheet2$]")
 
 Dim strReportText
 Dim strBaseName
 Dim strTextFile
 Dim nLines
 nLines = 11
  ' レコード件数分、順次取得します
 While Not rs.BOF And Not rs.EOF
  ' レコードセットにある情報をレポートテキストとして取得
 strReportText = GetReportTextFromRecordset( rs, nLines )
  ' レポートテキストをファイル出力
 Call WriteReportTextToFile( strReportText, strOutputFile )
 strTextFile = strTextFile & strReportText
  ' 次のレコードに移動
 rs.MoveNext
 Wend
End Sub

' レコードセットの内容をレポートテキストとして取得する
Function GetReportTextFromRecordset( rs, nLines )
 Dim strResult
 
 Dim str
 Dim strValue
 
 Dim fld

 Dim nLine
 nLine = 0
 Dim strFieldValue
 For Each fld In rs.Fields
 strFieldValue = GetFieldValueWithAddInfo(fld)
 If strFieldValue <> "" Then
  'デバッグ用
  'strResult = strResult & (nLine+1) & ":" & strFieldValue & vbCrLf
 strResult = strResult & strFieldValue & vbCrLf
 nLine = nLine + 1 ' 処理した件数ぶんカウントアップ
 End If
 Next
 
 Dim i
  ' 指定行数まで改行を追加する
 For i = nLine + 1 To nLines
 strResult = strResult & vbCrLf
 Next
 
 GetReportTextFromRecordset = strResult
End Function

' フィールドデータに追加情報を付与して返却する
Function GetFieldValueWithAddInfo( fld )
 Dim strResult
 strResult = ""
  '+---+----+---+---+--------+---+---+---+----------------------------------------------+
  '| A |B |C |D |E |F |G |H |I |
  '+---+----+---+---+--------+---+---+---+----------------------------------------------+
  '|001|馬 | | |horse |180| 25| 60|微妙な人間の表情を読み取れる |
  '|002|犬 | | |dog | 50| 15| 50|飼い主に従順 |
  '|003|ゾウ| | |elephant|600| 55| 40|個体差があり、気性が荒かったり従順だったりする|
  '|010|馬2 | | |horse2 | | | |微妙な人間の表情を読み取れる |
  '+---+----+---+---+--------+---+---+---+----------------------------------------------+
  ' : : : : : : : : :
  ' F1 F2 F3 F4 F5 F6 F7 F8 F9
  '
 Dim strAddInfo
  ' 列に応じて追加情報を取得する
 Select Case fld.Name
 Case "F6"
 strAddInfo = "cm"
 Case "F7"
 strAddInfo = "歳くらい"
 Case "F8"
 strAddInfo = "km/時"
 End Select
 
  ' フィールドデータがブランクでなければ情報を付与する
 If Not IsNull(fld.Value) And Not IsEmpty(fld.Value) Then
 strResult = fld.Value & strAddInfo
 End If
 
 GetFieldValueWithAddInfo = strResult
End Function


' データをファイル出力する
Function WriteReportTextToFile( strReportText, strOutputFile )
 Dim fso
 Set fso = CreateObject("Scripting.FileSystemObject")
 
 Dim strFileName
 strFileName = strOutputFile
 
 Dim file
 Set file = fso.OpenTextFile(strFileName, 8, True) ' 追加書き込みモード
 
  ' デバッグ用
  'WScript.Echo "[" & strFileName & "]"
  'WScript.Echo strReportText
  'WScript.Echo ""
 
 file.Write strReportText
 file.Close
End Function

ヘンリさんのコメント
cx20さんへ ご丁寧にコメントも添えて教えていただき、 ありがとうございます。 今の私ではスキルがあまりに乏しすぎて、 うまく扱えないのですが、とても貴重なコードだと思いますので テキストファイルに貼り付けて保存させていただきました。 大変お恥ずかしいですが、 VBScriptという言葉も今回はじめて聞いたくらいでして。 教えていただいたコードはどこに貼り付けたらいいのか、 今はそれもまだ分からないレベルですが、 今後活用できる日がくるようにしたいものです。

cx20さんのコメント
> VBScriptという言葉も今回はじめて聞いたくらいでして。 大変、失礼致しました。 ひらたく説明すると VBScript は VBA の兄弟のようなものです。 ・Excel VBA … Excel に付属している Basic 言語。Excel の機能を直接呼び出すことが可能。 ・VBScript … Windows OS に付属している Basic 言語。Excel の機能を間接的に呼び出すことが可能。 と言った感じです。 <参考情報> ■ VBScript 基礎文法最速マスター http://vbscript.g.hatena.ne.jp/cx20/20100131/1264906231 > 教えていただいたコードはどこに貼り付けたらいいのか、 本サンプルは、「ExcelToReportText.vbs」という名前で保存して頂き、 コマンドプロンプトより「CScript ExcelToReportText.vbs」と入力することにより実行することが可能です。 また、VBScript のソースコードの大半は、VBA でも利用可能です。実行される場合は以下の手順を参照ください。 ---------------------------------------------- 1. 本サンプルを VBA の編集画面に貼り付ける 2. 「Call Main」の行をコメントアウトする。 3. 「Sub Main()」を実行する。 → プログラムが実行され「出力データ.txt」が生成される。 ----------------------------------------------

ヘンリさんのコメント
cx20さんへ 物知らぬ私に、とても分かりやすくご説明いただきありがとうございます。 参考URLも教えていただき、ありがたいです。 ブックマークさせていただきました。 VBScriptの実行方法は、今の私にはいくら考えても分からないやり方だったんですね(笑い)! Basic言語を書ける方(私の拙い日本語をプログラム化で表現できる方)は、単純に神々しく見えます。 私も少しずつVBAが書けるようになりたいです。
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ