エクセルの学校：全文検索：Hyper Estraier： VBA��

Results of 1 - 1 of about 14729 for VBA�� (0.003 sec.)

[[20200309182736]]: #score: 3408; @digest: 83bfdef1fcdfa514e6b974067439939f; @id: 82607; @mdate: 2020-03-10T14:06:59Z; @size: 8268; @type: text/plain; #keywords: 用sh (46424), 0070062 (44989), checksheet (19771), タsh (14500), コパ (13965), 者名 (8670), lastcell (8314), 業用 (8097), 当者 (7325), 担当 (5944), 力用 (5133), ト分 (4399), autofilter (3791), 究用 (3315), criteria1 (2885), ペコ (2642), 出デ (2588), field (2463), activesheet (2412), 研究 (2170), 構文 (2075), 、担 (1826), 用シ (1804), 出力 (1790), officetanaka (1553), select (1466), worksheets (1466), after (1293), sheets (1225), sh (1202), 作業 (1178), 可変 (1125); 『【VBA】可変条件でシートを分かる方法』（ペコパ）
VBAに関して質問失礼いたします。社内システムでの抽出データに、担当者名が記載されています。マクロにて担当者名毎にシートを分けたいと思っていますが、難点なのが、担当者名が毎回変わります。（ある月のデータは、担当者名:A.B.Cですが、翌月は担当者名:D.E.Fになります。）この様な場合、VBAでシート分けは可能でしょうか。可能であれば、やり方を教えてください。＜使用 Excel:Excel2016、使用 OS:Windows10 ＞ ---- レイアウトも現状のコードの提示もないので当てずっぽう。 (1)担当者欄を見る (2)担当者A.B.C だったらシート1に貼付担当者D.E.F だったらシート2に貼付 (3)行数?分繰り返すでできませんか＞（もこな2 ） 2020/03/09(月) 18:54 ---- 説明不足で申し訳ありません。以下のようなレイアウトのエクセル表があります。担当者名ごとにシートを分けたいと思ってますが、今月は担当者がA,B,C、来月はD,E,Fと毎月担当者が変わります。名前が未知の新規担当者も入ってくる可能性があります。この場合、該当月の担当者名を取得し、 VBAで担当者名毎にシートを分けることは可能でしょうか。構文も教えていただけると助かります。以下「Macro1」は、マクロ記録で下表をシート分けした構文です。（構文は可変にはなっていません）この構文を一部つかえるのであれば、その部分を変更したらいいかなど、ご教授いただけると助かります。担当者名商品コード品名売上 A 0070062 ガーベラ 11,111 B 0964342 バラ 33,333 B 0686019 チューリップ 555 C 0070062 ミモザ 6,666 C 0070062 カーネーション 4,444 C 0367325 アネモネ 5,555 Sub Macro1() ' ' Macro1 Macro ' ' Range("A1").Select Selection.AutoFilter ActiveSheet.Range("$A$1:$D$7").AutoFilter Field:=1, Criteria1:="A" ActiveSheet.Range("$A$1:$D$7").AutoFilter Field:=1 Range("A2").Select ActiveSheet.Range("$A$1:$D$7").AutoFilter Field:=1, Criteria1:="A" Cells.Select Selection.Copy Sheets.Add After:=ActiveSheet ActiveSheet.Paste Sheets("Sheet2").Select Cells.Select Sheets("Sheet2").Name = "A" Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$D$7").AutoFilter Field:=1, Criteria1:="B" Cells.Select Application.CutCopyMode = False Selection.Copy Sheets.Add After:=ActiveSheet Sheets("Sheet3").Select Sheets("Sheet3").Name = "B" ActiveSheet.Paste Range("E10").Select Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$D$7").AutoFilter Field:=1, Criteria1:="C" Cells.Select Application.CutCopyMode = False Selection.Copy Sheets.Add After:=ActiveSheet Cells.Select ActiveSheet.Paste Sheets("Sheet4").Select Sheets("Sheet4").Name = "c" Sheets("Sheet1").Select Range("F7").Select ActiveSheet.Range("$A$1:$D$7").AutoFilter Field:=1 Range("A1").Select End Sub よろしくお願いいたします。（ペコパ） 2020/03/09(月) 20:51 ---- 参考に Sub Test() Dim myDic As Object, d As Variant Dim LastCell As Range, c As Range Set myDic = CreateObject("Scripting.Dictionary") With ActiveSheet Set LastCell = .Cells(Rows.Count, "D").End(xlUp) For Each c In .Range("A2", .Cells(Rows.Count, "A").End(xlUp)) myDic(c.Value) = Empty Next For Each d In myDic.keys 'シートの有無確認 If CheckSheet(d) = False Then '無ければ追加 Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = d End If .Range("A1").AutoFilter Field:=1, Criteria1:=d .Range("A2", LastCell).Copy Worksheets(d).Cells(Rows.Count, "A").End(xlUp).Offset(1) Next .AutoFilterMode = False .Activate End With End Sub Function CheckSheet(strSN As Variant) As Boolean Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets If ws.Name = strSN Then CheckSheet = True Exit For End If Next End Function （ピンク） 2020/03/09(月) 22:11 ---- ピンク様有難うございます!!! やりたいことができました。感動しました。。。すごいです。この構文、大事にとっておきます。本当にありがとうございます。（ペコパ） 2020/03/09(月) 22:52 ---- 既に回答ついてますが、↓のような表であれば、発想は提示されたような感じでよいとおもいます。 _____A___________B__________C______________D_________ 1 担当者名商品コード品名売上 2 A 0070062 ガーベラ 11,111 3 B 0964342 バラ 33,333 4 B 0686019 チューリップ 555 5 C 0070062 ミモザ 6,666 6 C 0070062 カーネーション 4,444 7 C 0367325 アネモネ 5,555 ポイントは、 (1) なんとかして、担当者名の重複しないリストを作成する (2) 担当者名のシートが無ければ作成する (3) データ元シートで、オートフィルタを使って担当者名で抽出する (4) 抽出されたものをコピーして、担当者名のシートに貼付する (5) (2)〜(4)を繰り返す。という処理をどうやって組み立てるかだとおもいます。このうち、(1),(3),(4)については、（アプローチによっては）マクロの記録でヒントとなるコードが得られます。また、 (1)については http://officetanaka.net/excel/vba/tips/tips80.htm (2)については http://officetanaka.net/excel/vba/tips/tips10.htm https://mmm-program.com/vba-sheet-exist/ (3)については http://officetanaka.net/excel/vba/tips/tips155.htm などが参考になると思いますので、興味があればチャレンジしたり読んでみてはどうでしょうか。長くなりましたが、最後に研究用のコードを提供します。こちらも、興味があれば【ステップ実行】して、何をやっているのか研究してみてください、 ※ステップ実行ってなんだ?という場合はこちらをご覧ください。 https://www.239-programing.com/excel-vba/basic/basic023.html http://marupeke296.com/DBG_No1_Step.html ※ブレークポイントってなんだ?という場合はこちらをご覧ください。 https://www.tipsfound.com/vba/01010 https://www.239-programing.com/excel-vba/basic/basic022.html Sub 研究用02() Dim 作業用SH As Worksheet Dim データSH As Worksheet Dim 出力用SH As Worksheet Dim i As Long, 最終行 As Long Stop '←ブレークポイントの代わり '▼データのあるシートを変数にセット Set データSH = ActiveSheet '▼作業用シートを作成して変数にセット Set 作業用SH = Worksheets.Add(before:=Worksheets(1)) '▼作業用シートに担当者名の重複しないリストを作成データSH.Range("A:A").Copy 作業用SH.Range("A1") 作業用SH.Range("A1").RemoveDuplicates Columns:=1, Header:=xlYes '▼作業用シートの2行目から最終行まで順番にループ処理最終行 = 作業用SH.Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To 最終行 '▼出力用のシートを準備 Set 出力用SH = Nothing On Error Resume Next Set 出力用SH = Worksheets(作業用SH.Cells(i, "A").Value) On Error GoTo 0 If 出力用SH Is Nothing Then Set 出力用SH = Worksheets.Add(after:=Worksheets(Worksheets.Count)) 出力用SH.Name = 作業用SH.Cells(i, "A").Value End If '▼データのあるシートでオートフィルタを実行して抽出データSH.Range("A1").AutoFilter Field:=1, Criteria1:=作業用SH.Cells(i, "A").Value '▼抽出したものをコピペデータSH.AutoFilter.Range.Copy 出力用SH.Range("A1") Next i '▼後処理 Application.DisplayAlerts = False 作業用SH.Delete データSH.AutoFilterMode = False Application.DisplayAlerts = True End Sub （もこな2） 2020/03/10(火) 08:42 ---- もこな2様とても分かりやすい解説、誠にありがとうございます!! 研究用のコード、とても助かります。早速勉強させていただきました。 1点質問なのですが、現コードではA列の項目別にシート分けして頂いておりますが、例えばA→G列に変更になった場合はシート分けは可能なのでしょうか。 TRYしてみたのですが、一応シート分けはできたのですが、ファイル内のタイトル行以下の必要情報が反映しませんでした。 A列（左端列）にないと、うまいこと分けるのは厳しい等、ルールはありますでしょうか。何度も聞いて申し訳ありませんが、ご教授いただけましたら幸いです。（なみ） 2020/03/10(火) 23:06 ...; https://www.excel.studio-kazu.jp/wiki/kazuwiki/202003/20200309182736.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ