アプリ版:「スタンプのみでお礼する」機能のリリースについて

こんにちは。考える40代の男性です。
vbaを使って下記のとおりsheet1の情報をD1からJ1をキーにしてA1からC1を集計し、その結果をsheet2の
E,G,L列の二行目より貼り付けたいと考えております。また、sheet1のD列とE列はsheet2では結合してsheet2のA2より表示させ、同じくsheet1に該当する項目をsheet2の二行目より貼り付けたいと考えております。
どなたかお力添えをお願いいたします。表がずれてますがお許しください。

sheet1
  M   P   S   T   U   V   W   X   Y   Z
1 金額 数量1 数量2 番号1 番号2 番号3 記号 識別 率 コード
2 153.10 10.00 19.00 620821 000 2 TR R 7.4% 11223
3 100.00 20.00 36.00 620921 090 7 TR R 7.4% 13333
4 450.00 10.00  4.00 620921 090 7 TR R 7.4% 24444
5 66.00 10.00  4.00 620821 000 2 TR R 7.4% 24444
6 45.00 6.00  4.00 620821 000 2 TR R 7.4% 24444
7 55.00 10.00  4.00 620821 000 2 TR R 7.4% 24444
8 153.10 9.00  4.00 620821 000 2 TR R 7.4% 24444

sheet2

  D     E     G    I    K   M   N    O   P
1 番号1  番号3   率 数量1 数量2 コード 記号  識別 金額

A 回答 (2件)

Sheet1とSheet2のレイアウトを同じにすることはできないのでしょうか?また、番号2と3の連結は必須ですか?


この辺を整理すれば、もっとシンプルなVBAで対応できそうですが、結果的に自分の首を絞めているような気がします。
ご要望の通りにすると、こんな感じです。コメントを豊富に付けましたので、ご参考までに。

Sub sample()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws As Worksheet
Dim I As Long
Set ws1 = ThisWorkbook.Sheets("Sheet1") '集計元シート定義
Set ws2 = ThisWorkbook.Sheets("Sheet2") '集計先シート定義
'集計元シートをコピーして、作業用シートとして定義
ws1.Copy
Set ws = ActiveSheet
'作業用シートから集計キー項目の重複行を削除
ws.Range("A:J").RemoveDuplicates _
Columns:=Array(4, 5, 6, 7, 8, 9, 10), Header:=xlYes
'作業用シートの集計
For I = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
ws.Cells(I, "A") = WorksheetFunction.SumIfs(ws1.Range("A:A"), _
ws1.Range("D:D"), ws.Cells(I, "D"), _
ws1.Range("E:E"), ws.Cells(I, "E"), _
ws1.Range("F:F"), ws.Cells(I, "F"), _
ws1.Range("G:G"), ws.Cells(I, "G"), _
ws1.Range("H:H"), ws.Cells(I, "H"), _
ws1.Range("I:I"), ws.Cells(I, "I"), _
ws1.Range("J:J"), ws.Cells(I, "J"))
ws.Cells(I, "B") = WorksheetFunction.SumIfs(ws1.Range("B:B"), _
ws1.Range("D:D"), ws.Cells(I, "D"), _
ws1.Range("E:E"), ws.Cells(I, "E"), _
ws1.Range("F:F"), ws.Cells(I, "F"), _
ws1.Range("G:G"), ws.Cells(I, "G"), _
ws1.Range("H:H"), ws.Cells(I, "H"), _
ws1.Range("I:I"), ws.Cells(I, "I"), _
ws1.Range("J:J"), ws.Cells(I, "J"))
ws.Cells(I, "C") = WorksheetFunction.SumIfs(ws1.Range("C:C"), _
ws1.Range("D:D"), ws.Cells(I, "D"), _
ws1.Range("E:E"), ws.Cells(I, "E"), _
ws1.Range("F:F"), ws.Cells(I, "F"), _
ws1.Range("G:G"), ws.Cells(I, "G"), _
ws1.Range("H:H"), ws.Cells(I, "H"), _
ws1.Range("I:I"), ws.Cells(I, "I"), _
ws1.Range("J:J"), ws.Cells(I, "J"))
Next I
'コピー先シートのクリアと作業用シートからの転記
ws2.Rows("2:" & Rows.Count).Delete
For I = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
ws2.Cells(I, "A") = ws.Cells(I, "D") '番号1
ws2.Cells(I, "B") = ws.Cells(I, "E") & ws.Cells(I, "F") '番号2+3
ws2.Cells(I, "C") = ws.Cells(I, "I") '率
ws2.Cells(I, "D") = ws.Cells(I, "B") '数量1
ws2.Cells(I, "E") = ws.Cells(I, "C") '数量2
ws2.Cells(I, "F") = ws.Cells(I, "J") 'コード
ws2.Cells(I, "G") = ws.Cells(I, "G") '記号
ws2.Cells(I, "H") = ws.Cells(I, "H") '識別
ws2.Cells(I, "I") = ws.Cells(I, "A") '金額
Next
'作業用シートを閉じる
ws.Parent.Close SaveChanges:=False
End Sub
    • good
    • 0

ご質問の意図が読み取りにくいので補足説明を追加いただいた方が良いかと。



「sheet1の情報をD1からJ1をキーにしてA1からC1を集計し」とは、具体的にどのような操作を行うのでしょうか?
また「下記のとおり」とありますが、データサンプルには説明文に登場する列の提示を、併せて期待する実行結果の例もご提示いただいた方が良いと思います。
    • good
    • 0

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