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

エクセルVBAマクロについて質問です。お気持ちのみですが、合計200p?差し上げます。
1)のデータから2)のデータ群を作るマクロを作って下さい。

1)samplefile.xls("Sheet1")
fnameA,fnameA,fnameA,fnameB,fnameB,fnameC,fnameC,・・・
lnameA,lnameB,lnameC,lnameD,lnameE,lnameF,lnameG,・・・
s1, s2, s3, s4, s5, s6, s7,・・・
s8, s9, s10, s11, s12, s13, s14,・・・



※"fnameA" ? "fnameC"として出力したいデータベースが、横に連続表記されたようなイメージです。
※1行目にファイルネームが、2行目はファイルネームに対応する列の名前を記載しています。
※1行目を順に右に読んでいって、ファイルネームが変更されたら次のxlsファイルを生成し、ブランクを発見したら終了、という動作です。

2)出力結果
●出力ファイル
fnameA.xls,fnameB.xls,fnameC.xls,・・・

●fnameA.xlsのSheets"fnameA"の中身
lnameA,lnameB
s1, s2
s8, s9



fnameB.xls,fnameC.xlsも同様

お力添えをよろしくお願い致します。

※類似質問
http://q.hatena.ne.jp/1162474581
ですが、まだファイルの読み書きに慣れていませんので質問させて頂きます。

●質問者: ReoReo7
●カテゴリ:コンピュータ ウェブ制作
✍キーワード:S2 VBA xls イメージ エクセル
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● Mook
●200ポイント ベストアンサー

実行するファイルと同じフォルダにファイルを作ります。

すでにファイルがあると保存時に警告が出るので、再度実行する際は

ファイルを削除もしくは退去してから実行してみてください。

Option Explicit

'-----------------------------------------------------------------------------------
Sub makeXLSs()
'-----------------------------------------------------------------------------------
 Dim i As Long
 Dim bookName As String

 Dim dstWB As Workbook
 Dim srcWS As Worksheet
 Dim srcRows As Long
 Dim dstCol As Long
 
 Set srcWS = ThisWorkbook.Worksheets("Sheet1")
 i = 1
 For i = 1 To srcWS.Cells(1, 1).End(xlToRight).Column
'--- ファイルを確認
 If srcWS.Cells(1, i).Value <> bookName Then
'--- データがあったら保存
 If Not dstWB Is Nothing Then
 dstWB.SaveAs ThisWorkbook.Path & "\" & bookName
 dstWB.Close
 End If
 bookName = srcWS.Cells(1, i).Value
 Workbooks.Add
 Set dstWB = ActiveWorkbook
 dstCol = 1
 End If
'--- データを転記
 srcRows = srcWS.Cells(2, i).End(xlDown).Row - 1
 srcWS.Cells(2, i).Resize(srcRows, 1).Copy Destination:=dstWB.Worksheets(1).Cells(1, dstCol)
 dstCol = dstCol + 1
 Next
'--- データがあったら保存
 If Not dstWB Is Nothing Then
 dstWB.SaveAs ThisWorkbook.Path & "\" & bookName
 dstWB.Close
 End If
End Sub
◎質問者からの返答

ありがとうございます。所望の動作を得られました!

シート名の変更にも対応して頂き、ありがとうございました。

感謝いたします。

関連質問


●質問をもっと探す●



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