こんばんわ。
取り急ぎ教えて下さい。

Excel2007を使用しています。
シートに得意先商品名一覧があります。
得意先毎にシートわけし、シート名には得意先名としたいのですが
得意先数が多い為VBAを使用したいと考えています。
ご教授願えないでしょうか?
得意先数は都度変わります。

例>シート名:得意先一覧
A列(得意先名)     B列(商品名)  C列(単価)
得意先A         商品A      10円
得意先A         商品B      10円
得意先A         商品C      10円
得意先A         商品D      10円
得意先B         商品A      10円
得意先B         商品B      10円
得意先B         商品C      10円
得意先B         商品D      10円
得意先B         商品E      10円
得意先B         商品F      10円
得意先C         商品A      10円
得意先C         商品B      10円



シート名:得意先A
得意先A         商品A      10円
得意先A         商品B      10円
得意先A         商品C      10円
得意先A         商品D      10円

シート名:得意先B
得意先B         商品A      10円
得意先B         商品B      10円
得意先B         商品C      10円
得意先B         商品D      10円
得意先B         商品E      10円
得意先B         商品F      10円

シート名:得意先C
得意先C         商品A      10円
得意先C         商品B      10円


よろしくお願いします。

このQ&Aに関連する最新のQ&A

A 回答 (1件)

これも丸投げ質問だ。

したいことだけ言っているが、何か自分でやってみたのかな。人に頼りすぎだろう。
ーー
色んな方法があるが、シートを作るVBAは
フィルタオプションの設定で重複するレコードは無視するで、重複の無い会社名一覧が出る。
G列に出したとする。
例データ
A列(得意先名)B列(商品名)C列(単価)
得意先A商品A10円
得意先A商品B10円
得意先A商品C10円
得意先A商品D10円
得意先B商品A10円
得意先B商品B10円
得意先B商品C10円
得意先B商品D10円
得意先B商品E10円
得意先B商品F11円
得意先C商品F12円
得意先D商品F13円
ーーー
G列
A列(得意先名)
得意先A
得意先B
得意先C
得意先D
ーーーー
Sub test01()
d = Worksheets("Sheet1").Range("G65536").End(xlUp).Row
MsgBox d
For i = 2 To d
Sheets.Add.Activate
ActiveSheet.Name = Worksheets("Sheet1").Cells(i, "G")
Next i
End Sub
ーー
この先は
フィルタオプションの設定をマクロの記録でも採って考えること。
明細も要るなら、100社ぐらいなら、質問してるより、手作業でコピペした方が、結局速いはず。
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qフリーソフトで、WAVファイルを音楽CD-Rにコピーして、カースレテオ

フリーソフトで、WAVファイルを音楽CD-Rにコピーして、カースレテオで再生できることを目指しています。どうも、この関係のソフトは、WAVファイルを音楽CD-Rにコピーできても、PCでしか再生できないなど、がっかりさせられることが多く、まだ運命のソフトに巡り合っていません。最終的には、音楽CD-Rをカーステレオで再生できないと意味がありません。私の希望を満たすフリーソフトをご存じの方教えてください。

Aベストアンサー

DeepBurnerとか

  ”オーディオCD 作成” で検索してお好きなアプリを選択

QExcel VBAでオートフィルタで抽出した列データを別シートの最終行にコピーするには

添付図を参照してください。
元データがある表(シート名:統計)へ(シート名:Sheet1)にあるオートフィルタで抽出したデータを統計 シートの最終行を判断して、Sheet1のA列とD列の該当のデータのみをコピーして
シートの最終行から貼り付けをするマクロを作成したいです。
最終行を判断するには、
Range(Selection, Selection.End(xlDown)).Select など記述すべきかと思いますが、
あくまでSheet1の抽出したデータ行は15行までではなくデータにより様々な行数を取得するようにしたいです。Range("A2", Range("A2").End(xlDown)).Select など?

すいませんが、ご教授頂きますようお願いいたします。

Aベストアンサー

No.1です。

>ちなみにオートフィルタでC列”教科”を算数、E列”ランク”をAを組み込む場合は・・・

コード内に"教科"と"ランク"を組み込んでしまうと汎用性がなくなると思いますので、
インプットボックスで"教科"と"ランク"を入力するようにしてみました。

Sub Sample2()
Dim lastRow As Long, wS As Worksheet, myRng As Range
Dim Kyouka As String, myRnk As String
Set wS = Worksheets("統計")
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set myRng = Range(.Cells(2, "A"), .Cells(lastRow, "E"))
Kyouka = Application.InputBox("フィルタを掛ける教科を入力")
myRnk = Application.InputBox("フィルタを掛けるランクを入力")
With .Range("A1")
.AutoFilter field:=3, Criteria1:=Kyouka
.AutoFilter field:=5, Criteria1:=myRnk
End With
If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
myRng.SpecialCells(xlCellTypeVisible).Copy wS.Cells(Rows.Count, "A").End(xlUp).Offset(1)
wS.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
End If
.AutoFilterMode = False
End With
End Sub

こんな感じではどうでしょうか?m(_ _)m

No.1です。

>ちなみにオートフィルタでC列”教科”を算数、E列”ランク”をAを組み込む場合は・・・

コード内に"教科"と"ランク"を組み込んでしまうと汎用性がなくなると思いますので、
インプットボックスで"教科"と"ランク"を入力するようにしてみました。

Sub Sample2()
Dim lastRow As Long, wS As Worksheet, myRng As Range
Dim Kyouka As String, myRnk As String
Set wS = Worksheets("統計")
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Ro...続きを読む

QフリーソフトをCD-RやUSBメモリなどに保存して、他のPCにコピーし

フリーソフトをCD-RやUSBメモリなどに保存して、他のPCにコピーしたい(他のPCはインターネットがつながっていない環境なのでダウンロードできない・・・)のですが使用できるようになる方法を教えてください。

※やりたいこと
普段使用しているPCに入っているダウンロードしたフリーソフトを他のPCでも使いたいが、インターネットがつながっていない。

コピーしてペーストではうまくいきませんでした。
そもそもコピーペーストなんかでは使用できないのでしょうか?基本的なことからわかっていないと思いますので、どうぞ宜しくお願い致します。
環境はwinXPです。

Aベストアンサー

インストールタイプのソフトは、ダウンロードした状態のままコピーしていますか?
インストールタイプのソフトは、レジストリやProgram Filesフォルダ以外の所に
ファイルを保存しているソフトがあるので、使うパソコンでインストールしないといけません。
インターネットに繋いでいないとインストール出来ないタイプのソフトがありますが、
この場合は無理です。
インストールタイプでも、Program Filesフォルダ以外にファイルを作ったり、
レジストリを書き換えたりがなければ可能な場合がありますが、
あまり良くないのでできるだけしない方がいいです。

>コピーしてペーストではうまくいきませんでした。
とありますが、何かエラーか何か出たのでしょうか?
詳しいことが分からないので何とも言えませんが、
ソフトがそのパソコンに対応していない場合も考えられます。
ランタイムライブラリが必要な場合もあります。

ファイルを解凍してそのまま使えるタイプであれば、コピーしても基本的に可能です。

QExcelのVBAを使ってタイトル行が2行ある場合の別シートへの抽出方法

会社で契約書の終了日を見て、終了日の3か月前になったらそのデータを別シートに抽出できるようにマクロを考えています。

マクロの記録といろいろ調べ、一度下記のマクロを作成し、テストしたところうまくいったのですが、本番環境でマクロを利用したところエラーが出て利用ができませんでした。

テスト環境と本番環境で大きく違うのが、タイトル行(画像だと4-5行目)が2行になっており、ほとんどのセルでセルの結合がされているとこかと思います。

普通にオートフィルターをかえても4行目(上の行)にフィルターがかかってしまい、5行目でオートフィルターが利用できません。(一度解除してやり直してみましたが、結果は同じ4行目にフィルターがかかりました)

Sub 更新確認マクロ()
'
Selection.AutoFilter
Range("A4").CurrentRegion.AutoFilter Field:=11, Criteria1:="Check"
Range("A4").CurrentRegion.Copy Sheets("Sheet2").Range("A1")
Selection.AutoFilter

これをタイトル行が2行ある場合のVBAの書き方などヒントも含めあれば教えていただけないでしょうか。
VBA初心者でいくつか調べてみたのですが、どれもうまくいかず。。。
よろしくお願いします。

Windows7/Excel2010利用

会社で契約書の終了日を見て、終了日の3か月前になったらそのデータを別シートに抽出できるようにマクロを考えています。

マクロの記録といろいろ調べ、一度下記のマクロを作成し、テストしたところうまくいったのですが、本番環境でマクロを利用したところエラーが出て利用ができませんでした。

テスト環境と本番環境で大きく違うのが、タイトル行(画像だと4-5行目)が2行になっており、ほとんどのセルでセルの結合がされているとこかと思います。

普通にオートフィルターをかえても4行目(上の行)に...続きを読む

Aベストアンサー

見出しの下の行にフィルタをかければ、いけるのでは…。
こんな感じです。

Sub 更新確認マクロ()
'
Rows(5).AutoFilter
Range("A4").CurrentRegion.AutoFilter Field:=11, Criteria1:="Check"
Range("A4").CurrentRegion.Copy Sheets("Sheet2").Range("A1")
Selection.AutoFilter
End Sub

QPCの文をコピーするとしゃべるフリーソフトを探しています。

PCの文をコピーするとしゃべるフリーソフトを探しています。

以前上記のようなフリーソフトを愛用していたのですが、PCが壊れて新しいのを買いました。
またダウンロードして使いたいのですが、名前を覚えていません。

特徴と言えるほどでもないんですが、水色っぽくて、パックンのような印象がありました。
コピーすると合成音声でしゃべってくれます。

また、探しているソフトでなくても、他のフリーソフトでオススメなものがありましたら教えていただけると嬉しいです。

Aベストアンサー

>水色っぽくて、パックンのような印象
【 SofTalk 】のことでしょうか?
http://www.gigafree.net/media/record/softalk.html
本家
http://cncc.hp.infoseek.co.jp/

Qシートをコピーして新規シートへ値貼付け後、指定フォルダへ保存

題名の通りのVBAコードを作成したのですが、ファイルの保存先が、指定フォルダでは無く、
最後に指定したフォルダへ保存されてしまいます。

どこがおかしいのかご教示頂けますでしょうか。

Private Sub シート保存_Click()

Windows("A.xlsm").Activate
Dim FLname As String
Range("F11,G11").Select
FLname = "申込書_" & Range("F11") & "_" & Range("G11") & ".xlsx"

Workbooks.Add

ActiveWorkbook.SaveAs Filename:=FLname, FileFormat:=xlOpenXMLWorkbook

Windows("A.xlsm").Activate
Cells.Select
Selection.Copy
Windows(FLname).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ChDir "\\TEST\test"
ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

題名の通りのVBAコードを作成したのですが、ファイルの保存先が、指定フォルダでは無く、
最後に指定したフォルダへ保存されてしまいます。

どこがおかしいのかご教示頂けますでしょうか。

Private Sub シート保存_Click()

Windows("A.xlsm").Activate
Dim FLname As String
Range("F11,G11").Select
FLname = "申込書_" & Range("F11") & "_" & Range("G11") & ".xlsx"

Workbooks.Add

ActiveWorkbook.SaveAs Filename:=FLname, FileFormat:=xlOpenXMLWorkbook

Windows("A.xlsm...続きを読む

Aベストアンサー

こんにちは


>ファイルの保存先が、指定フォルダでは無く、
>最後に指定したフォルダへ保存されてしまいます。
保存先としたいフォルダは、\\TEST\testということでしょうか?

>ActiveWorkbook.SaveAs~~
のところで、思い通りにならないのかと想像しますが、パラメータに
 Filename:="\\TEST\test\" & FLname
を加えてもうまくいきませんか?
https://msdn.microsoft.com/ja-jp/library/office/ff841185.aspx

Qデータ、音楽等をコピーできるフリーソフト

CDRなどに、データ、音楽等をコピーできるフリーソフトを探しています。
Easy CDみたいなフリーソフトありませんか?
皆さんのお勧めを教えてください。
ちなみにOSはWindows98です。
よろしくお願いします。

Aベストアンサー

バルクでもない限り、CD-R/RWのドライブに付属されていたはずですが、付属ソフトのどんな点がご不満なんでしょうか?

参考URL:http://www.forest.impress.co.jp/article/2002/12/17/cdmanipulator.html

QExcel2007VBAシートコピーとマクロ保存

●質問の主旨
複数のシートのファイルにおいて最終シートだけをコピーし、
かつそのファイルの標準モジュールも含んだファイルを保存するには、
下記のコードをどのように書き換えたらいいでしょうか?
ご存知のかたご教示願います。

●コード
Sub 保存()

Dim flname As String


flname = "D:\医療週報\VBA試作\" & Format(Date, "yyyy年mm月") & ".xlsx"
ActiveSheet.Copy

ActiveWorkbook.SaveAs flname
ActiveWorkbook.Close

End Sub

●質問の補足
1)マクロで「保存」を実行するときは手作業で必ず最終ページを開いています(アクティブにします)。
2)上記コードのうち".xlsx"では最終シートだけをコピーできますが、
マクロの保存ができません。また".xlsm"にするとエラーが出ます。
".xls"にすると複数のシートが全てコピーされた上に、マクロの保存ができていません。
3)私はVBA初心者です。

●質問の主旨
複数のシートのファイルにおいて最終シートだけをコピーし、
かつそのファイルの標準モジュールも含んだファイルを保存するには、
下記のコードをどのように書き換えたらいいでしょうか?
ご存知のかたご教示願います。

●コード
Sub 保存()

Dim flname As String


flname = "D:\医療週報\VBA試作\" & Format(Date, "yyyy年mm月") & ".xlsx"
ActiveSheet.Copy

ActiveWorkbook.SaveAs flname
ActiveWorkbook.Close

End Sub

●質問の補足
1)マクロで「保存」...続きを読む

Aベストアンサー

dradra33 様

こんなのでどうでしょう?

特に質問に記載がなかったので「『マクロを実行するブック』の最終ページ(一番右端と解釈しました)を標準モジュール付きで別名保存する」こととして回答します。
 
それと、結局ファイルの拡張子を何にするのか良く分からなかったのでxlsxにするようにしています。


Sub Tset()
Dim s As Worksheet, flname As String

'保存ファイル名を取得
flname = "D:\医療週報\VBA試作\" & Format(Date, "yyyy年mm月")

'シート削除時のメッセージを非表示
Application.DisplayAlerts = False

'全シートをループ
For Each s In ThisWorkbook.Worksheets

'一番右のシート番号でなければ削除
If s.Index <> ThisWorkbook.Worksheets.Count Then
s.Delete
End If

Next
Application.DisplayAlerts = True

'保存
ActiveWorkbook.SaveAs Filename:=flname, FileFormat:=xlNormal
'xlsmが良ければ、FileFormat:=xlOpenXMLWorkbookMacroEnabled とする
End Sub

dradra33 様

こんなのでどうでしょう?

特に質問に記載がなかったので「『マクロを実行するブック』の最終ページ(一番右端と解釈しました)を標準モジュール付きで別名保存する」こととして回答します。
 
それと、結局ファイルの拡張子を何にするのか良く分からなかったのでxlsxにするようにしています。


Sub Tset()
Dim s As Worksheet, flname As String

'保存ファイル名を取得
flname = "D:\医療週報\VBA試作\" & Format(Date, "yyyy年mm月")

'シート削除時のメッセージを非表示
Appli...続きを読む

QDVDのコピーのフリーソフト

DVDがコピーできるオススメ(使いやすい)のフリーソフトを教えてください。

Aベストアンサー

こちら
http://www.forest.impress.co.jp/lib/sys/hardcust/cddvdburn/cdburnerxp.html

QExcel VBA別ブックのシートをコピーするには

Excel2010のVBAで別ブックのシートをコピーしてくる方法

Excelファイル(C:\test\BOOK2.xls)のシート名が
TESTというシートを自分のExcelファイル(C:\doc\BOOK1.xls)に
コピーするにはどのように記述すればよいのでしょうか。

・コピー先:自分のExcelファイル(C:\doc\BOOK1.xls)
 VBAのコードがあるファイルです
・コピー元:C:\test\BOOK2.xlsのTESTシート
 なお、TESTシートを持つ同じ名前(BOOK2.xls)のファイルが
 別フォルダにもあります
 
Workbooks( )の引数にファイル名(BOOK2.xls)は指定できるのですが、
フルパス名(C:\test\BOOK2.xls)で指定できないので困っています。

Aベストアンサー

http://www016.upp.so-net.ne.jp/cheetah/xlvba/Excel/Worksheet/Worksheet04.html に書いてある方法はどうでしょうか。

Set wb1 = Application.Workbooks.Add
Set wb2 = Application.Workbooks.Add

のところを

Set wb1 = Application.Workbooks.Open(Filename:="ファイル名")
Set wb1 = Application.Workbooks.Open(Filename:="ファイル名")

のように書き換えれば出来ると思います。

参考URL:http://www016.upp.so-net.ne.jp/cheetah/xlvba/Excel/Worksheet/Worksheet04.html


人気Q&Aランキング

おすすめ情報