こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

-広告-

解決済みの質問

表の形式の変換マクロ

添付上図を下図のタイプに変換するマクロの作り方を御教示お願いします。
ピボットテーブルの逆のパターンと考えればわかりやすいです。

項目、年、それからY軸のデータ数は変化しますので、それに対応するやり方でお願いします。
どうぞよろしくお願いします。

投稿日時 - 2016-01-12 09:09:35

QNo.9110039

困ってます

質問者が選んだベストアンサー

こんにちは
  Set k = s1.Range("A1:C1") '項目セル範囲
  Set n = s1.Range("D1:F1") '年度セル範囲

  On Error Resume Next
  Set k = Application.InputBox("項目セル範囲を選択して下さい。", , , , , , , 8)
  Set n = Application.InputBox("年度セル範囲を選択して下さい。", , , , , , , 8)
  If k Is Nothing Or n Is Nothing Then Exit Sub
  On Error GoTo 0
に変更して下さい。

投稿日時 - 2016-01-12 11:45:56

お礼

ますます使いやすくなりました。
どうもありがとうございます。

投稿日時 - 2016-01-12 12:49:32

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

-広告-
-広告-

回答(2)

ANo.1

こんにちは
シート名と項目セルと年度セルは都度修正してもらうとして、
Sub test()
  Dim k As Range
  Dim n As Range
  Dim s1 As Worksheet
  Dim s2 As Worksheet
  Dim t As Worksheet
  Dim r As Range
  Dim e As Range
  
  Set s1 = Worksheets("Sheet1")
  Set k = s1.Range("A1:C1") '項目セル範囲
  Set n = s1.Range("D1:F1") '年度セル範囲
  
  Application.ScreenUpdating = False
  
  Set s2 = Worksheets("Sheet2")
  s2.UsedRange.ClearContents
  
  Set t = Worksheets.Add
  
  k.Copy s2.Range("A1")
  s2.Range("A1").End(xlToRight).Offset(, 1) = "年"
  s2.Range("A1").End(xlToRight).Offset(, 1) = "数量"
  
  k.Copy t.Range("A1")
  Set e = t.Range("A1").End(xlToRight).Offset(, 1)
  
  For Each r In n
    t.UsedRange.Offset(1).ClearContents
    r.Copy e.Resize(, 2)
    s1.Range("A1").CurrentRegion.AdvancedFilter _
      Action:=xlFilterCopy, _
      CopyToRange:=t.Range("A1").CurrentRegion, Unique:=False
    Intersect(t.Range("A1").CurrentRegion, e.Cells(1, 1).EntireColumn).Value = r.Value
    t.UsedRange.Offset(1).Copy s2.Range("A" & Rows.Count).End(xlUp).Offset(1)
  Next
  Application.DisplayAlerts = False
  t.Delete
  Application.DisplayAlerts = True
  
  Application.ScreenUpdating = True
  
End Sub
とかで。

投稿日時 - 2016-01-12 09:45:42

お礼

どうもありがとうございます。うまくいきました。
もう一つ甘えていいでしょうか。項目と年度をVBAを実行したときに聞いてくるようにするにはどうしたらよいでしょうか。
よろしくお願いします。

投稿日時 - 2016-01-12 11:22:15

-広告-
-広告-

あなたにオススメの質問

-広告-
-広告-