[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『担当者毎にシートわけしたい』（しのみや）
14時30分頃に質問させてもらったのですが、 未のマークがつかなかったので、再度質問させてもらいます （私の不手際だったらすみません）
教えてください 【元データ１】 ○Dataシート A B C 1 2 3 番号 商品 担当者 4 100 りんご A 5 230 トマト B 6 280 いちご B 7 350 メロン C 8 390 もも A 9 410 なし A ↓ 最終行は可変 【やりたいこと】 担当者毎のシートを作成し、その担当者の人の行のみ貼り付ける 【希望の結果】 ------------------------ ○Aシート A B C 1 2 3 番号 商品 名前 4 100 りんご A 5 390 もも A 6 410 なし A ------------------------ ○Bシート A B C 1 2 3 番号 商品 名前 4 230 トマト B 5 280 いちご B ------------------------ ○Cシート A B C 1 2 3 番号 商品 名前 4 350 メロン C ------------------------ 【考えたこと】 オートフィルタで絞り込んで、それぞれのシートに貼り付けるとか… マクロの記述にしようとするとどうもパッとしないというか… よい方法があったら教えてください
＜ 使用 Excel：Excel2010、使用 OS：Windows10 ＞
現状のアプローチで大体良いようにおもいますが、ループ処理と組み合わせたいということであれば
(1)作業用のシートを追加する (2)[Dataシート]のA3〜A列最終行までを,(1)のA1セルに貼り付ける (3)(2)に対して「重複の削除」を実行し、重複のないリストを作成する (4)[作業用シート]のA2〜A列最終行までセルの値を検索値として
(5)[Dataシート]にオートフィルタを設定し３列目が検索値であるものを抽出 (6)[Dataシート]のオートフィルタが設定されている範囲をコピー (7)[検索値 & "シート"シート]のA3セルに貼付
(8)作業シートを削除
のようにしてみてはどうでしょうか？
この方法であれば、ループ処理の部分を除き、大体の必要な命令は【マクロの記録】でしらべることができるとおもいます。
肝心のループ処理については、過去の質問を振り返れば答えがみつかるんじゃないですかね。
（もこな２ ） 2020/09/11(金) 17:08
こんばんは！ 方法は沢山あると思います。 私風に書いてみました。。。 良かったら参考にしてください。。。 では、、、では、、、
Option Explicit
Sub てすと()
Dim MyA As Variant
Dim x As Variant
Dim y() As Variant
Dim z As Variant
Dim v As Variant
Dim MySh As String
Dim i As Long
Dim j As Long
Dim n As Long
ReDim y(0)
ReDim z(0)
With Sheets("元データ１")
MyA = .Range("A3").CurrentRegion.Resize(, 3).Value
For i = LBound(MyA, 1) + 1 To UBound(MyA, 1)
If Not Evaluate("=ISREF('" & "○" & MyA(i, 3) & "'!A1)") Then Sheets.Add.Name = "○" & MyA(i, 3)
x = Application.Match(MyA(i, 3), z, 0)
If IsError(x) Then
ReDim Preserve y(n)
ReDim Preserve z(n)
y(n) = .Range("A3").Resize(, 3).Value
z(n) = MyA(i, 3)
n = n + 1
End If
Next
For i = LBound(MyA, 1) + 1 To UBound(MyA, 1)
x = Application.Match(MyA(i, 3), z, 0)
If Not IsError(x) Then
v = Application.Transpose(y(x - 1))
ReDim Preserve v(LBound(v, 1) To UBound(v, 1), LBound(v, 2) To UBound(v, 2) + 1)
For j = LBound(MyA, 2) To UBound(MyA, 2)
v(j, UBound(v, 2)) = MyA(i, j)
Next
y(x - 1) = Application.Transpose(v)
End If
Next
End With
For i = LBound(y) To UBound(y)
v = y(i)
MySh = "○" & v(UBound(v, 1), UBound(v, 2))
With Sheets(MySh)
.Cells.Clear
.Range("A3").Resize(UBound(v, 1), UBound(v, 2)).Value = v
End With
Next
Erase MyA, y, z, v
End Sub
（SoulMan） 2020/09/11(金) 18:01
もこな２さん ありがとうございます
おっしゃるようにマクロの記録とループで作れると思いますので 今までそうやって作ってきたのですが… この質問箱で教えて頂くと、毎回新しい発見があるので質問させて頂きました
（下記に頂いたSoulManさんの記述を読ませてもらって思っていることなのですが） おそらくマクロの記録では、セル範囲の設定が固定（という表現はおかしいかもですが）ですので、 そのあたりの私の勉強が足りないのかなと考えています
SoulManさん ありがとうございます
頂いた記述を読ませてもらっておりまして、まだ途中までしか理解できていないのですが… わからない点があり、もしお時間よければ教えて下さい
１
MyA = .Range("A3").CurrentRegion.Resize(, 3).Value は、
MyA = .Range("A3").CurrentRegion だけでも問題ないと思うのですが、
理由がなにかあるのでしょうか？
２
If IsError(x) Then
ReDim Preserve y(n)
ReDim Preserve z(n)
y(n) = .Range("A3").Resize(, 3).Value
z(n) = MyA(i, 3)
n = n + 1
End If
既にシートがなければ、担当者毎のシートを作成の流れで
上記の記述は何をしているのでしょうか？
（しのみや） 2020/09/14(月) 11:03
こんばんは！ めちゃくちゃレスポンスが悪くて本当に申し訳ございません。 昼間は、おかげさまでめ〜〜いっぱい働いていますのでIphoneを見る余裕もありません。m(__)m
さて、お問い合わせの 1 ですが、
MyA = .Range("A3").CurrentRegion
だけでも問題ないといえば問題ありません。
でも、次のステートメントでインデックスの 3 を使用しますから
必ずデータは3列分あって欲しいのです。
意図からすると、1つでも二つでもだめ、、必ず三つ欲しい。。。
かつ、4つ以上はあってもいらない。。。という書き手の意図です。
次に、ご質問の 2 です。 これは、配列を使って各シートに振り分けたいのですが、 いくつ配列が必要なのかわかりませんよね？ つまり担当者が何人いらっしゃるかわからないので 空の配列を一つ作って担当者ごとに格納していきます。 その際に、二次元の配列を取得していきます。 この様な配列を 多段配列 とか ジグザグ配列 というそうです。(あまり詳しくありません。m(__)m） y(n)(i,j) こんなイメージです。。。
最近、お問い合わせが続きますので緊張しております。。です。。。 私みたいな我流コードでも参考にして頂けたら幸いです。
では、、では、、また。。。 （SoulMan） 2020/09/14(月) 19:55
Sub テキトー()
Dim 作業シート As Worksheet
Dim i As Long
Dim 最終行 As Long
Stop
Worksheets.Add before:=Worksheets(1) '★
Set 作業シート = Worksheets(1)
With Worksheets("Data")
.AutoFilterMode = False
.Range("C3:C" & .Cells(.Rows.Count, "A").End(xlUp).Row).Copy 作業シート.Range("A1")
End With
With 作業シート
.Range("A1", .Cells(Rows.Count, "A").End(xlUp)).RemoveDuplicates Columns:=1, Header:=xlYes '★
最終行 = 作業シート.Cells(Rows.Count, "A").End(xlUp).Row
End With
With Worksheets("Data")
For i = 2 To 最終行
.Range("A3").AutoFilter Field:=3, Criteria1:=作業シート.Cells(i, "A").Value '★
.AutoFilter.Range.Copy Worksheets(作業シート.Cells(i, "A").Value).Range("A3")
Next
End With
Application.DisplayAlerts = False
作業シート.Delete '★
Application.DisplayAlerts = True
End Sub
（もこな２） 2020/09/15(火) 04:09
SoulManさん ありがとうございます
お忙しいところ教えてくださり助かります ひとつひとつ調べているので、重箱の隅をつつくような質問になっていたらすみません…
質問１ 了解しました 明示的に記述をしているのですね
質問２ 私が作るとLoopで配列変数に +1して入れていくことが多いので、 多段配列が使いこなせるようになれるといいな…頑張ります
勉強になりますm(_ _)m
質問ばかりですみませんが… マクロの記録をすると、このようには記述されないと思うのですが、 何か別の言語から入られたのでしょうか？
もこな２さん ありがとうございます
＞＞どの部分が希望と異なるのですか？ 異なってはいませんです
私もマクロの記録を使って書くと、 書いて頂いた記述にたどり着いていると思います
私の「パッとしない」という書き方が悪かったのですが、
同じ動きなのに、多段配列を使って書かれている記述？は全然違って見えていて どうしたら自分もそのように書けるんだろうと勉強したいなと思いました （もやもやを言語化できておらず、後付けで申し訳ないです）
もこな２さんが書いてくださった記述はすごく見やすい書き方ですし、 メンテナンスもしやすそうです
（しのみや） 2020/09/15(火) 10:11
"多段配列"という言葉は耳慣れませんが、たぶんジャグ配列のことですよね。
話があまり飲み込めませんが最初の投稿の時点で当該を使った処理の学習をしたかったということでしょうか。
ジャグ配列について、私は説明出来るほど詳しくありませんが、このサイトでも当該についていくつかコメントを見かけたことがありますので、過去ログを読んでみるのも良いかもしれません。
ちなみに、私の提示した方法は、重複のないリストを得るために作業シートをにコピーしてから重複の削除をしているわけですが、連想配列（Dictionaryオブジェクト）等を使ってメモリ上だけでリストを作ることは可能です。
最初に提示しなかったのは、メモリ上だけで処理されてしまうのでなかなかステップ実行して観察しづらいとおもったので避けた次第です。
重複しないリストの作成について興味があれば↓を読んでみると理解しやすいとおもいます。
【Office TANAKA】 http://officetanaka.net/excel/vba/tips/tips80.htm
最後に、連想配列を使った例など提示しておきます。
Sub テキトー2()
Dim i As Long
Dim objDIC As Object
Set objDIC = CreateObject("Scripting.Dictionary")
Dim リスト As Variant
With Worksheets("Data")
'連想配列で重複しないリストを作る
On Error Resume Next
For i = 4 To .Cells(.Rows.Count, "C").End(xlUp).Row
objDIC.Add .Cells(i, "C").Value, .Cells(i, "C").Value
Next i
On Error GoTo 0
'ここで重複のない1次元の配列をゲット
リスト = objDIC.Keys
'オートフィルタを強制解除する
.AutoFilterMode = False
For i = 0 To UBound(リスト)
'抽出する
.Range("A3").AutoFilter Field:=3, Criteria1:=リスト(i)
'コピペする
.AutoFilter.Range.Copy Worksheets(リスト(i)).Range("A3")
Next i
'オートフィルタを強制解除する
.AutoFilterMode = False
End With
End Sub
（もこな２ ） 2020/09/15(火) 13:26
こんばんは！ >何か別の言語から入られたのでしょうか？ どうなんでしょうね？？？よく覚えていませんが、Excelしかしらないのでそれはないですね 昨夜気になって調べてみましたら、多段階配列 と 階 が入るのですね(^^; 自分が使っている配列の呼び方も知らないとはお粗末ですね(如何に検索していないかですね）
私たちのころはこんなサイトやインターネットなんてのはありませんでしたから。。。 ほんとどうやって覚えたんでしょうね？？？20年は言い過ぎでも15〜17年くらい前なら普通に使ってましたからねぇ でも、ローカルウィンドウの + をクリックするとy(1)(1,2)なんて構造はよく見かけるでしょ？ まぁ、普通にあるもんなんですよ
私は、実務派ですから業務に追われて必然的に身についたんでしょうね？上司様のおかげで(笑) ご自身の使いやすいメンテしやすいコードにされたらいいですよ。 せっかく書いても使われないコードは悲しいですから、、、でも、引き出しは多いほうがいいかな？？？
あっ、以前も書きましたがコードを解読するときは印刷するといいですよ。 エディターというかぁ、、画面だけではやっぱりだめで全体を呑み込むにはやっぱりペーパーがいいと思います。 蛍光ペンや落書きも出来ますしね。
もうお後がよろしいようで、、、頑張ってください。。。
では、、では、、 また。。。 （SoulMan） 2020/09/15(火) 19:56
Sub test()
Dim dic As Object
Dim v
Dim i As Long
Dim 担当者 As String
Dim k
Set dic = CreateObject("scripting.dictionary")
v = Worksheets("元データ１").Range("A3").CurrentRegion.Value
For i = 2 To UBound(v)
担当者 = v(i, 3)
If Not dic.exists(担当者) Then
Set dic(担当者) = CreateObject("scripting.dictionary")
dic(担当者)(0) = Application.Index(v, 1)
End If
dic(担当者)(dic(担当者).Count) = Application.Index(v, i)
Next
For Each k In dic.keys
If Not Evaluate("isref('" & k & "'!A1)") Then
Worksheets.Add.Name = k
End If
With Worksheets(k).Range("A3")
.CurrentRegion.ClearContents
.Resize(dic(k).Count, 3).Value = Application.Index(dic(k).items, 0)
End With
Next
End Sub
（マナ） 2020/09/15(火) 20:18
Sub test2()
Dim tbl As Range
Dim c As Range
Dim 担当者 As String
Set tbl = Worksheets("元データ１").Range("A3").CurrentRegion
Set c = tbl(1).Offset(, tbl.Columns.Count + 1)
tbl.Columns(3).AdvancedFilter xlFilterCopy, , c, True
Do While c(2).Value <> ""
担当者 = c(2).Value
c(2).Formula = "=""=" & 担当者 & """"
If Not Evaluate("isref('" & 担当者 & "'!A1)") Then
Worksheets.Add.Name = 担当者
End If
tbl.AdvancedFilter xlFilterCopy, c.Resize(2), Worksheets(担当者).Range("A3:C3")
c(2).Delete xlShiftUp
Loop
c.Clear
End Sub
（マナ） 2020/09/15(火) 20:23
Sub テキトー2_改()
Dim i As Long, 担当者 As Variant
Dim objDIC As Object: Set objDIC = CreateObject("Scripting.Dictionary")
With Worksheets("Data")
On Error Resume Next
For i = 4 To .Cells(.Rows.Count, "C").End(xlUp).Row
objDIC.Add .Cells(i, "C").Value, ""
Next i
On Error GoTo 0
.AutoFilterMode = False
For Each 担当者 In objDIC.Keys
.Range("A3").AutoFilter Field:=3, Criteria1:=担当者
.AutoFilter.Range.Copy Worksheets(担当者).Range("A3")
Next 担当者
.AutoFilterMode = False
End With
End Sub
（もこな２） 2020/09/16(水) 12:27
Dim c As Range
For Each c In Sheets("Data").Range("C4:C" & Rows.Count).SpecialCells(2)
Call shtexists(c.Value)
Sheets(c.Value).Range("A3:C3").Value = Array("番号", "商品", "名前")
Sheets(c.Value).Range("A" & WorksheetFunction.CountIf(c.EntireColumn.Resize(c.Row), c.Value) + 3).Resize(, 3).Value = c.Offset(, -2).Resize(, 3).Value
Next c
End Sub
Function shtexists(arg)
Dim temp
On Error GoTo ere
temp = Sheets(arg).Range("A1").Value
GoTo skp
ere:
Sheets.Add(after:=Sheets(Sheets.Count)).Name = arg
skp:
End Function
（mm） 2020/09/16(水) 16:55
＞ 【考えたこと】
＞オートフィルタで絞り込んで、それぞれのシートに貼り付けるとか…
＞マクロの記述にしようとするとどうもパッとしないというか…
＞よい方法があったら教えてください
えっと、
例えば、オートフィルターの機能で、
▼をクリック
↓
選択肢をクリック
↓
抽出されたものが表示される
という操作と
シート毎に抽出してあったとして、
シートタブクリック
↓
抽出してあったものが表示
と、なるわけですが、
結局は、やりたいことを
「見たいデータを、見たいときに表示」が出来れば、
裏でどのようなことをやっていようが使う人は関係ないわけです。
で、マクロを使えば（オートフィルタを使うも含む）、元のデータさえあれば、
瞬時に意図したものが表示ができるので、
「事前に分けておく」必要がない上に、
データが2重に存在するということになり、
好ましくないなと思う反面、
何かを選択するという操作で、
「タブを選択」するという操作は、なかなか使い勝手がよい
（手動のオートフィルターの操作は、なんだか不評で教えても使ってもらえない）
のも事実です。
また、フィルターオプションという機能でも抽出は出来ますが、
手動でやると、たいていエラーが出て使い方が難しいですが、
マクロで書くとすごく短いコードになり便利です。
ということで、
各担当者のシートをクリックしたときに、
そのシート名をキーワードに、フィルターオプションを使って、そのシートに抽出してくる。
というような仕組みを作ることにチャレンジしてみてはいかがでしょうか？
欲しい結果を得る、手順を洗練させていくのもありかと思いました。
（まっつわん） 2020/09/16(水) 20:05
もこな２さん ありがとうございます 自分でも整理できておらず、ふわふわした質問ですみません 連想配列…というものがあるのですね 修正のマクロもありがとうございます 勉強になります 自分が足りていない部分の入口が見えたような気がします
SoulManさん ありがとうございます Excelから始められてこんな風にかけるのですね 私の記述はマクロの記録とLoopだったりで…動いてはいますが、 改善の余地ありですので、頑張ります
マナさん ありがとうございます 同じ動作でも、マクロにするとこんなに違うのですね 全体の行数もずいぶん変わりますし…
mmさん ありがとうございます デバッグして勉強させてもらいます
シート分割は自分が扱えそうなマクロを活用させてもらいたいと思いますが、 いろんなパターンの書き方を頂きありがとうございます 理解が深まるように、動きを確認していきたいと思います 今すぐには時間が取れないので、後から確認させてもらいます
まっつわんさん ありがとうございます シート分けをしているのは、シートわけしたファイルを担当者全員にお渡しして 自分のシートを見てもらうという流れが決まっておりまして 担当者は確認だけで何かの操作は必要なく、閲覧のみのファイル（マクロがついたファイルを渡さない）の方が良いと 今回は考えております 幅広い知識を頂きありがとうございます （しのみや） 2020/09/17(木) 11:13
"ジグザグ配列"と言う言葉が出てきましたが、これは一般的ですか？
"jagged array"に相当する日本語のようですが、余り聞いたことがなかったです。
"ジャグ配列"と言う言葉のほうが一般的な気がしました。
（ネット検索すると、とある英語サイトを翻訳したものの中での使用例がトップに表示されます。
翻訳ではない形で使われているのは、ちょっと見あたら無かったですね。
一般に使われるものなのでしょうか。
なお、Googleの機械翻訳は、"ギザギザ配列"と翻訳しますけど、これもちょっと怪しい。
jaggedの意味にはギザギザというものがあるようですけど。一要素ではなく配列なのでギザギザなのか？）
いずれにせよ,Variant型の配列であれば、なんでも突っ込めるわけですから、
便利は便利ですね。他の言語でも使われると思います。
特に気軽にpush,popなどをする使い方を併用すると便利と言えば便利です。
（γ） 2020/09/17(木) 11:51
こんばんは！ >"ジグザグ配列"と言う言葉が出てきましたが、これは一般的ですか？ どうなんでしょうね？ ジグザグ配列で検索すると割と上の方に出てくるのが↓こちらの方が書かれてるサイトですが、 https://riptutorial.com/ja/vba/example/16563/%E3%82%B8%E3%82%B0%E3%82%B6%E3%82%B0%E9%85%8D%E5%88%97-%E9%85%8D%E5%88%97%E3%81%AE%E9%85%8D%E5%88%97- ぱっと見ですけど、配列の配列という記述が私的にはしっくりときました。 逆に私は、ジャグ配列というのを初めてではないでしょうけど聞きました。
元々、私は多段配列という呼び方をしていましたのでこれは私の 階 の見落としでしょう 私はコードから入って呼び方が後からついてきた感がありますので最初にジグザク配列という呼び方を聞いたときは 「変なの」と思った記憶はあります。(笑)
どこで見たかはほんと記憶にございません。。。
余談ついでに校長先生にお願いがあります。 雑談部屋といいますか、コミュニティーBOXといいますか、、放課後のＨＲいたいな部屋があるといいなと思いました。 とは言え、校長先生のご負担も増えるでしょうからどこかの片隅にでも置いていただけたら幸いです。 （SoulMan） 2020/09/17(木) 19:26
引用されたサイトは、有名なStack Overflowという質問掲示板によるまとめ記事のようで
海外のサイトを各国版に翻訳したものですね。日本の方が翻訳しているものではないかも。
その記事の中でさえ、
・ギザギザ配列
・ジグザグ配列
・ジャグ配列
・ジャグド配列
・Jagged Array
などと色々な訳し方がされています。
訳語の統一ができていないので、用語については少なくとも余り信用できないんじゃないかと思います。
機械翻訳そのままか、少し手を入れたくらいのものでしょう。
（むろん英語ではjagged Arrayで一貫してますけど。）
（γ） 2020/09/17(木) 21:22
日本語も様々で多段配列と紹介されているサイトもあるようですね。 https://smdn.jp/programming/netfx/arrays/1_multidimensional/ （SoulMan） 2020/09/17(木) 22:04
以下、そちらから引用。
| 多次元配列は通常の配列(1次元配列)の次元を拡張したもので、マトリックスやグリッド、
| テーブルの様な矩形の構造を持ったデータ構造であることから、矩形配列とも呼ばれます。
| (§.多次元配列 (矩形配列))
|
| 一方、ジャグ配列は配列を格納することができる配列(配列の配列)であり、その事から
| 多段配列とも呼ばれます。 ジャグ配列は、常に矩形である多次元配列とは異なり構造が
| ギザギザ(jagged)になることが、その名前の由来となっています。 (§.ジャグ配列 (多段配列))
|
| ジャグ配列は多次元配列とは異なり、異なる要素数の配列を格納することができます。 例えば、
| 2次元配列が持ちうる要素数は1次元目の長さがn、2次元目の長さがm個とすると計n×m個となり、
| 常に次元ごとの長さの積が全要素数となります。 一方、2段のジャグ配列ではa個の配列+b個の
| 配列+c個の配列…とジャグ配列内に格納されている配列の要素数の和となります。
# PCが不調となり、急遽バックアップ作業に追われてしまいました。
# まあ、全体がゴミなので、ゴミをバックアップしてどうするという気は正直しましたけどねえ。
（γ） 2020/09/18(金) 07:27
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.