[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『EXCELでデータごとに分割したファイルを作成』（あるしんど）
こんにちは。
お知恵を拝借いたしたく、質問させて頂きます。
【状況】
ひとつのﾌｧｲﾙに複数のサプライヤーｺｰﾄﾞ（A列）・複数の拠点（B列）・実績（C列〜J列）があります。
A列 B列 C列
AAAAAA 東京 150
BBBBBB 東京 200
AAAAAA 神奈川 100
CCCCC 大阪 600
AAAAAA 東京 100
データは不規則で、1000行程度です。
【やりたいこと】
１・オートフィルター機能を使って、A列B列を軸に新規ファイルを作成したい
（上記ｻﾝﾌﾟﾙであれば、AAAAA_東京、AAAAA_神奈川、BBBBB_東京、AAAAA_神奈川…という形です）
２・新規作成されたファイルは「A列_B列_JISSEKI.xls」というﾌｧｲﾙ名にしたい
（上記ｻﾝﾌﾟﾙであれば、AAAAA_東京_JISSEKI.xls、AAAAA_神奈川_JISSEKI.xls…という形です）
いろいろ調べたのですが、うまくできません。
何卒ご教示を御願いいたします。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
最終的な形が見えてこないのですが ファイルを作って中身がC列のみですか？
AAAAAA_東京_JISSEKI.xls の中身
Sheet1
|[A]
[1]|150
[2]|100
BBBBBB_東京_JISSEKI.xls の中身
Sheet1
|[A]
[1]|200
＞いろいろ調べたのですが、うまくできません。 このうまく出来なかった手順を説明してもらえますか？ （稲葉） 2016/02/04(木) 15:41
はじめまして。ご回答有難うございます。
最終的な形はA列〜J列のデータが入っている状態になります。
＞いろいろ調べたのですが、うまくできません。 このうまく出来なかった手順を説明してもらえますか？
検索をして出た、似た事例のマクロを使用したのですが、複数のフィルタの場合に当てはまらず
うまくできませんでした。
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q11115019411
恐れ入りますが、何卒宜しくお願いいたします。
（あるしんど） 2016/02/04(木) 15:52
マクロの記録で大体行けると思いますが、頑張るつもりはないですか？
一番右の列に（1行目に項目名が有るとして） =A2&"_"&B2 の式を入れて、フィルハンドルをダブルクリックして最終行までコピー
入力した式をコピーして、新しいシートに「値として貼付」 張りつけた値を選択して重複の削除
★元のシートに戻って、式を入力した列でフィルターを掛ける Ctrl + *を押して表範囲を取得し、コピー
新規ブックを作ってA1を選択して、値として貼付 張りつけたブックを名前を付けて保存
ここまで記録すれば、あとは★のところをFor文で繰り返し処理すればいいものができますよ！
（稲葉） 2016/02/04(木) 16:31
パソコン閉じるので叩き台です。 出来るだけ自分で頑張ってみてください。
myPathとWSの設定はご自身に合わせてください
Option Explicit
'=====実行するコード
Sub ファイルを作って消す()
'========================================
Dim WS As Worksheet
Dim w As Variant
Dim k As Variant
Dim myPath As String
myPath = "C:\エクセルの学校\てすと\"
Set WS = Sheets("Sheet1")
With WS.Range("J2:J" & WS.Cells(Rows.Count, "A").End(xlUp).Row)
.Formula = "=A2&""_""&B2"
w = 重複の削除(.Value)
End With
WS.AutoFilterMode = False
For Each k In w
With WS.Range("A1").CurrentRegion
.AutoFilter field:=10, Criteria1:=k
.Copy
End With
Workbooks.Add
With ActiveWorkbook
.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
.Sheets(1).Range("J1").EntireColumn.Delete
On Error Resume Next
.SaveAs Filename:=myPath & k & ".xlsx"
On Error GoTo 0
.Close
End With
Next k
WS.AutoFilterMode = False
WS.Range("J1").EntireColumn.Delete
MsgBox "処理が完了しました"
End Sub
'=====重複しないリストを作るユーザー関数
Private Function 重複の削除(w) As Variant
'========================================
Dim k
Dim i As Long
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(w, 1)
.Item(w(i, 1)) = ""
Next i
重複の削除 = .keys
End With
End Function
（稲葉） 2016/02/04(木) 18:25
こんにちは。お忙しい中、ご教示まことに有難うございます。
大変感謝いたします。
いただきましたコードでセル番などを変更し、実行いたしましたところ
作成できました！
本当に有難うございます。
さらにお聞きしたいのですが、出来上がったファイルをシステムに載せるために
ファイル形式を「xls」にする必要があり、
.SaveAs Filename:=myPath & k & ".xlsx"
の箇所を
.SaveAs Filename:=myPath & k & ".xls"
へ変更してみました。
ファイルは作成されるのですが、ファイルを開くときに「拡張子が壊れている可能性があります」という
注意が入ってしまいます（OKをクリックすると、ファイルは開きます）
xlsファイルを開く上で避けられない問題でしょうか？
回避方法をご存知でしたら、ご教示頂きたく何卒宜しくお願いいたします。
（あるしんど） 2016/02/05(金) 11:28
.SaveAsメソッドで検索してください。
互換性やらのダイヤログが出たら application.displayalerts で検索してください
まずは検索する癖付けてみてね。 （稲葉） 2016/02/05(金) 12:06
稲葉さんからコメントが出ていますが、困ったときは、まず 検索ですよね。 それと、もう１つ。マクロ記録も強力なツールです。
XLSX ブック あるいは XLSMブックを エクセル97-2003 ブック を指定して名前を付けて保存する、その操作を マクロ記録してみましょう。 保存時にどんなパラメータが指定されているかをチェックしてみてください。
（β） 2016/02/05(金) 13:24
こんにちは。
ご回答ならびにヒントを有難うございました。
検索もせずに頼り切った内容で大変申し訳ございませんでした。
土日にがんばって検索・検討を重ねてまいります。
その際にまたご質問させていただくかも知れませんが、その際は何卒ご容赦いただければと
存じます。
ご親身になっていただき、本当に有難うございました。
（あるしんど） 2016/02/05(金) 15:50
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.