Q&A
なかったことにします。
前提・実現したいこと
クライアントごと人毎に実績時間の集計を行っております
sheet（仕様書）に条件、人、時間を入力し、別のsheet（当期）に比較表を作成しようしております
ボタンをクリックしたら入力しているセルの範囲をsheet（当期）の対象期間に追加するようにしたいです
条件①：役割（リーダー等） ⇒ A列区分、B列コード
条件②：氏名 ⇒ D列氏名、E列コード
条件③：決算期：H21
対象期間 ⇒ H23
入力しているセルの範囲 ⇒ 開始列H25、終了列H26
※ピンク色のセルは手入力箇所です
例：対象期間「1Q」のセル範囲「K22：S28」をsheet当期のA23に貼り付ける。
対象期間「2Q」のセル範囲「K22：N28」を元にsheet当期のA列～D列に人を追加する。
（区分コード昇順、氏名コード昇順）
セル範囲「O22：S28」をsheet当期21行目が「2Q」の場所に追加する。
↓
データを追加すると
発生している問題・エラーメッセージ
仕様書に入力した条件をもとにsheet（当期）に人毎に比較表を作成できず困っております。
・昇順第1位は区分コード、第2は氏名コードとし、入力しているセルの範囲を最終行まで決算期の箇所にコピーします。
・必ずしも全員でないこと、入力しているセルの範囲に空白があること、決算期によってメンバー（氏名）が異なる場合があることが最大のネックとなっております。
ご教授お願いできますでしょうか。
↓は決算期が1Qの場合を作成してみましたが最終行までにするにはどうしたらいいかわからず途中までとなっております。
手動の場合の動き（イメージ）
（1）sheet仕様書に条件①～③を入力する
（2）sheet仕様書に集計（人毎時間）を入力する
（3）対象期間が「1Q」の場合
①sheet仕様書のセル範囲「K列からS列」までをコピーする
②sheet当期時間のA23に貼り付ける
（4）対象期間が「2Q」の場合
①sheet仕様書の「K列からM列」とsheet当期時間が同じか調べる
②①が同じ場合はsheet仕様書の「O列からS列」をsheet当期時間「J列からN列」に貼り付ける
③①が違う場合はsheet当期時間に行を挿入し、sheet仕様書の「K列からN列」をsheet当期時間「A列からD列」に貼り付ける
同じ行にsheet仕様書の「O列からS列」を貼り付ける
該当のソースコード
Sub Macro1() Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("仕様書") Set ws2 = Worksheets("当期") r = ws1.Cells(Rows.Count, "K").End(xlUp).Row If ws1.Range("H23").Value = "1Q" Then 'ws1.Range(.Cells(22, .Range("H25").Value), _ '.Cells(r, .Range("H26").Value)).Copy 'ws1.Range("K22:S28").Copy ws2.Range("A16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 'Else If 'ws1.Range End If End Sub
質問内容を修正してみました。
もしまだ分かりにくいようでしたらご連絡ください
よろしくお願いいたします。
改めて５分くらい見てますが
何言ってんのか、わからない質問なんですよね。
１Q、２Q、３Qが何なのかとか・・。
質問者さんは、スッキリまとめた表なんでしょうけど。
>>決算期が1Qの場合を作成してみましたが最終行までにするにはどうしたらいいかわからず
>>決算期によってメンバー（氏名）が異なる場合があることが最大のネックとなっております。
？？
削除します
削除します
コメントありがとうございます
＞１Q、２Q、３Qが何なのかとか
対象期間の略称です
四半期ごとに実績をまとめております
＞sheet（当期）へ氏名（人物ごと）を左側にとり、1Q、2Q、3Qを氏名ごとの表に集約したいが
＞実績がない人物もあり、表ごとに氏名や人数が異なるためどうまとめていいかわからず困っている。
＞ということでしょうか。
区分、氏名ごとです
同じ人でも対象期間によって区分が異なる場合があります
実績がないだけでなく、常に同じメンバーでないためどうまとめていいかわからず困っています。
＞A16とは？
A23のミスです
様式の変更が反映されておりませんでした。
回答2件
0
仕様書に入力した条件をもとにsheet（当期）に人毎に比較表を作成できず困っております。
えっと、
仕様書とか
比較表という言葉がどうしてもこちらのイメージとずれてしまって、
回答がしにくいです。
仕様書シート→データを入力するシート？
比較表シート→各入力を横並びに並べて表示するシート？
ということでしょうか？
たぶんこういうことは、エクセルでは「ピボットテーブル」という機能で
比較的簡単にできます。
が、
それはエクセル君の想定されるデータの形（１行１件で表示される）で、
まずはシート上に入力されないといけません。
当然VBAを駆使すれば、
どんな形でも対応可能なんですが、
そうなると自作する部分が多くて、
難易度が上がります。
まずは手動で、エクセルの機能を使えるよう勉強したほうが得策かと
思います。
とりあえず、いまのままで開発を進めたいなら、
まずは日本語で作業手順を表現するところから始めましょう。
それと同時に操作したいセル範囲を特定できるようになりましょう。
難しく説明されていますが、要は、
「当期期間」シートの 23行目の「仕様書」シートの「H23」セルの値と同じ値のセルがある列全体と
「当期期間」シートのDのデータがある行全体が重なるセル範囲に、
氏名に合わせた行に転記したいということですよね？
ちょこっとアドバイスをして、
ちゃちゃっとできるようなことではないので、
少しづつテーマを絞って勉強していってみてはいかがでしょうか？
投稿2020/08/14 00:25
総合スコア2163
削除します。
0
レスがつかないようなので再UPします。
仕様書が意味があるのか、理解に苦しむところでレスがつかないものと思われます。
また、解釈が違うようでしたらスルーして結構です。
検証データQ1、検証データQ2のデータをコピーして検証をお願いします。
あらかじめ、当期シートに検証用データQ1のデータを貼り付けてあります。
仕様書シートに検証用データQ2を貼り付けてあります。
仕様書シートの対象期間をQ2にして実行ボタンをクリックするとマクロを実行できます。
注意点として、当期シートの見出しがグループ化されていることでソートがうまくいかないため
タイトル行の結合を解除していることに注意してください。
以上 よろしくお願いいたします。
VBA
1Sub Macro1() 2 3Dim ws1 As Worksheet 4Dim ws2 As Worksheet 5Dim maxrow1 As Double 6Dim maxrow2 As Double 7 8Dim namecode As Integer 9Dim i As Double 10Dim sortmaxrow As Double 11 12 13 Set ws1 = Worksheets("仕様書") 14 Set ws2 = Worksheets("当期") 15 16 maxrow1 = ws1.Cells(Rows.Count, "K").End(xlUp).Row '仕様書シートのデータ数を取得 17 maxrow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row '当期シートのデータ数を取得 18 19'■Q1 20 21 If ws1.Range("H23").Value = "1Q" Then 22 ws2.Range("A23:i" & maxrow1 + 1).Value = ws1.Range("K22:S" & maxrow1).Value 23 MsgBox "１Qのデータをコピーしました！" 24 End If 25 26 27 28'■Q2 29 If ws1.Range("H23").Value = "2Q" Then 30 31 For i = 22 To maxrow1 32 33 namecode = ws1.Range("M" & i).Value 34 35 namecode_cnt = WorksheetFunction.CountIf(ws2.Range("C23:C" & maxrow2), namecode) 36 37 If namecode_cnt = 0 Then 38 39 maxrow2 = maxrow2 + 1 40 41 ws2.Range("A" & maxrow2).Value = ws1.Range("K" & i).Value 42 ws2.Range("B" & maxrow2).Value = ws1.Range("L" & i).Value 43 ws2.Range("C" & maxrow2).Value = ws1.Range("M" & i).Value 44 ws2.Range("D" & maxrow2).Value = ws1.Range("N" & i).Value 45 46 ws2.Range("J" & maxrow2).Value = ws1.Range("O" & i).Value 47 ws2.Range("K" & maxrow2).Value = ws1.Range("P" & i).Value 48 ws2.Range("L" & maxrow2).Value = ws1.Range("Q" & i).Value 49 ws2.Range("M" & maxrow2).Value = ws1.Range("R" & i).Value 50 ws2.Range("N" & maxrow2).Value = ws1.Range("S" & i).Value 51 52 End If 53 54 55 If namecode_cnt = 1 Then 56 57 cellno = WorksheetFunction.Match(namecode, ws2.Range("C23:C" & maxrow2), 0) 58 59 ws2.Range("J" & cellno + 22).Value = ws1.Range("O" & i).Value 60 ws2.Range("K" & cellno + 22).Value = ws1.Range("P" & i).Value 61 ws2.Range("L" & cellno + 22).Value = ws1.Range("Q" & i).Value 62 ws2.Range("M" & cellno + 22).Value = ws1.Range("R" & i).Value 63 ws2.Range("N" & cellno + 22).Value = ws1.Range("S" & i).Value 64 65 66 End If 67 68 Next 69 70 sortmaxrow = ws2.Cells(Rows.Count, "A").End(xlUp).Row 71 72 Call mysort(sortmaxrow) 73 74 75 MsgBox "データをQ2に転記し、データをソートしました！" 76 77 End If 78 79 Set ws1 = Nothing 80 Set ws2 = Nothing 81 82 83End Sub 84 85Sub mysort(sortmaxrow As Double) 86 87 With Sheets("当期") 88 .Sort.SortFields.Clear 89 .Range("A22:S" & sortmaxrow).Sort _ 90 Key1:=.Range("A23"), Order1:=xlAscending, _ 91 Key2:=.Range("C23"), Order2:=xlAscending, _ 92 Header:=xlYes 93 94 End With 95 96End Sub 97 98
投稿2020/08/08 00:40
編集2020/08/13 10:59総合スコア383
あなたの回答
tips
プレビュー
