EXCEL VBA 表の行列入れ替え

質問

お世話になります。

添付(1)のような表があります。

行に日付(可変)がきて、担当者毎の売上金額(日々)、売上金額(累計)がきます。

この表に対して「集計」というボタンをクリックしたら(2)のように行に担当者がきて列に日付がくるような表に変えたいのです。

このVBAのロジックを、どなたかご教授いただけませんでしょうか？
お忙しいところ恐れ入りますがよろしくお願い致します。

環境 Excle2013 Windows7

回答No.2

tom04 · ベストアンサー

No.1です。
たびたびごめんなさい。
前回のコードで1行変更してください。
エラー処理をしていませんでした。

＞.Formula = "=VLOOKUP(C$1&""_""&$A2,Sheet1!$A:$E,MATCH($B2,Sheet1!$2:$2,FALSE),FALSE)"
の行を
＞.Formula = "=IFERROR(VLOOKUP(C$1&""_""&$A2,Sheet1!$A:$E,MATCH($B2,Sheet1!$2:$2,FALSE),FALSE),"""")"
.Value = .Value
にやり替えてください。

何度も失礼しました。m(_ _)m

お礼

tom04さん、早速のご連絡ありがとうございました！

ご教授いただきましたロジックで希望通りの動作が出来ました！！完壁すぎてまたまた感動です！！

いつもいつも本当にありがとうございます！！

回答No.1

tom04

こんにちは！
一例です。

↓の画像のような感じでSheet1のデータをSheet2に表示するようにしてみました。
画像では左側がSheet1とします。
Sheet1にコマンドボタン（オートシェイプでも構いません）を挿入するとします。

まずAlt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペーストしてください。

Sub Sample1() 'この行から
Dim i As Long, lastRow As Long, endRow As Long, lastCol As Long
Dim c As Range, wS As Worksheet
Set wS = Worksheets("Sheet2")
Application.ScreenUpdating = False
wS.Cells.Clear
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A:A").Insert
With Range(.Cells(3, "A"), .Cells(lastRow, "A"))
.Formula = "=B3&""_""&C3"
.Value = .Value
End With
Range(.Cells(2, "B"), .Cells(lastRow, "B")).AdvancedFilter Action:=xlFilterCopy, copytorange:= _
wS.Range("A1"), unique:=True
endRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS.Cells(2, "A"), wS.Cells(endRow, "A")).Copy
wS.Range("C1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
wS.Range("A:A").Clear
wS.Range("A1") = .Range("C2")
wS.Range("B1") = "売上"
For i = 3 To .Cells(Rows.Count, "A").End(xlUp).Row
endRow = wS.Cells(Rows.Count, "B").End(xlUp).Row + 1
Set c = wS.Range("A:A").Find(what:=.Cells(i, "C"), LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
wS.Cells(endRow, "A").Resize(2) = .Cells(i, "C")
wS.Cells(endRow, "B") = .Cells(2, "D")
wS.Cells(endRow + 1, "B") = .Cells(2, "E")
End If
Next i
lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
lastCol = wS.Cells(1, Columns.Count).End(xlToLeft).Column
With Range(wS.Cells(2, "C"), wS.Cells(lastRow, lastCol))
.Formula = "=VLOOKUP(C$1&""_""&$A2,Sheet1!$A:$E,MATCH($B2,Sheet1!$2:$2,FALSE),FALSE)"
.Value = .Value
End With
.Range("A:A").Delete
For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row Step 2
wS.Cells(i + 1, "A").ClearContents
wS.Cells(i, "A").Resize(2).Merge
Next i
End With
Application.ScreenUpdating = True
End Sub 'この行まで

Excel画面に戻りコマンドボタンのコードを↓の3行だけにします。

Private Sub CommandButton1_Click()
Call Sample1
End Sub

最後にデザインモードを解除してコマンドボタンをクリックしてみてください

※　日付セルはシリアル値かどうかは考慮していません。m(_ _)m