ここから本文です

初めての質問です!エクセルVBAを用いた抽出マクロについて。超初心者です。 ...

o0_********さん

2014/6/1611:44:10

初めての質問です!エクセルVBAを用いた抽出マクロについて。超初心者です。
全社.xlsに
①在庫データ(A1:P50000)のあるsheet”Data”

②支店別の課コード構成(A1:B50)が明記されているsheet”支店構成”
があります。

A列の課コードをキーに支店別に新規ファイルを作成し、対象のデータ行を元のデータは消さずに、コピー&ペーストで振り分けたいです。
*****DataSheet*****
A列 B列 C列 D列 E列・・・
課コード 社員 取引先 個数 機種・・etc.
100 太郎 あ 3個
200 花子 い 2個
300 次郎 う 3個
400 三郎 え 2個
500 月子 お 3個

*****支店構成sheet*****
A列 B列
支店名(ファイル名) 課コード
大阪支店.xls 100,300・・・etc.
東京支店.xls 200,500・・・ etc.
名古屋支店.xls ・・・
(課コードのリストは、カンマで区切って1つのセルに書いていますが、1セル1コードにして、横にのばしてもいいんですが・・・)

丸投げですみません。
2週間くらい、最初の変数の宣言から四苦八苦していて、ここにおすがりすることにしました。
どなたか、具体的なご教授頂けると助かります。

閲覧数:
117
回答数:
1
お礼:
500枚

違反報告

ベストアンサーに選ばれた回答

pom********さん

2014/6/1711:56:40

こんな感じで。

----------
Public Const MAX_SHITEN_CNT = 50 '支店構成シートの最大行数
Public Const MAX_ZAIKO_CNT = 50000 '在庫データの最大行数

Public Const Sheet1_name = "Data"
Public Const Sheet2_name = "支店構成"
Public BaseBook_name As String
Public NewBook_name As String
Public NewSheet_name As String
'

Sub Macro1()
'
' Macro1 Macro
'
Dim Shiten As Variant
Dim Shiten_cnt As Long
Dim Row As Long
Dim astrTemp() As String
Dim Ix As Long
Dim Filter_ret As Boolean
Dim Stmp As String
Dim New_cnt As Long



BaseBook_name = Excel.ActiveWorkbook.Name

For Shiten_cnt = 2 To MAX_SHITEN_CNT
If Workbooks(BaseBook_name).Sheets(Sheet2_name).cells(Shiten_cnt, 1) = "" Then Exit For
Shiten = Split(Workbooks(BaseBook_name).Sheets(Sheet2_name).cells(Shiten_cnt, 2).Value, ",")

Workbooks.Add
NewBook_name = Excel.ActiveWorkbook.Name
NewSheet_name = Excel.ActiveSheet.Name
New_cnt = 1
For Row = 2 To MAX_ZAIKO_CNT
Windows(BaseBook_name).Activate
Sheets(Sheet1_name).Select

If cells(Row, 1) = "" Then Exit For

astrTemp = Filter(Shiten, cells(Row, 1))
Filter_ret = False
For Ix = 0 To UBound(astrTemp)
If astrTemp(Ix) = cells(Row, 1) Then
Filter_ret = True
Exit For
End If
Next Ix
If Filter_ret Then
Stmp = Row & ":" & Row
Rows(Stmp).Select
Selection.Copy
Windows(NewBook_name).Activate
Sheets(NewSheet_name).cells(New_cnt, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
New_cnt = New_cnt + 1
End If
Next Row
Windows(NewBook_name).Activate
ActiveWorkbook.SaveAs _
Filename:=Workbooks(BaseBook_name).Sheets(Sheet2_name).cells(Shiten_cnt, 1).Value, _
FileFormat:=xlOpenXMLWorkbook
ActiveWindow.Close

Next Shiten_cnt
End Sub
----------
ちなみに、支店構成Sheetの課コードですが、セルの表示形式が標準のままだと、例えば「100,200,300」は、1億20万3百と判断されて、マクロが正しく動作しません。セルの表示形式は、必ず文字列にしてください。

質問した人からのコメント

2014/6/23 16:11:01

降参 ややこしい質問に、丁寧に答えて頂き感謝いたします!
作ってくださったのを、読み解く程の知識が、まだありませんでした(泣)
これから、頑張ります。ありがとうございました!!

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる