Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9812 / 76736 ←次へ | 前へ→

【72481】sheet1のデータをsheet2に整形して抽出する方法
質問  タケル  - 12/8/15(水) 14:45 -

引用なし
パスワード
   【sheet1】に

   A , B , C , D , E , F , G , H , I , J , K ,
1 _____,____,項目1,項目2,項目3,項目4,項目5,項目6,項目7,項目8,項目9,
2 _____,____,_____,_____,_____,_____,_____,_____,_____,_____,_____,←空白の行
3 東京 , 12 , c3 , d3 , e3 , f3 , g3 , h3 , i3 , j3 , k3 ,
4 東京 , 12 , c4 , d4 , e4 , f4 , g4 , h4 , i4 , j4 , k4 ,
5 東京 , 12 , c5 , d5 , e5 , f5 , g5 , h5 , i5 , j5 , k5 ,
6 東京 , 12 , c6 , d6 , e6 , f6 , g6 , h6 , i6 , j6 ,_____,
7 東京 , 12 , c7 , d7 , e7 , f7 , g7 , h7 , i7 , j7 ,_____,
8 東京 , 12 , c8 , d8 , e8 , f8 , g8 , h8 , i8 , j8 ,_____,
9 東京 , 12 , c9 , d9 , e9 , f9 , g9 , h9 , i9 , j9 ,_____,
10 東京 , 12 , c10 , d10 , e10 , f10 , g10 , h10 , i10 , j10 ,_____,
11 東京 , 12 , c11 , d11 , e11 , f11 , g11 , h11 , i11 , j11 ,_____,
12 東京 , 12 , c12 , d12 , e12 , f12 , g12 , h12 , i12 , j12 ,_____,
13 東京 , 12 , c13 , d13 , e13 , f13 , g13 , h13 , i13 , j13 ,_____,
14 東京 , 12 , c14 , d14 , e14 , f14 , g14 , h14 , i14 , j14 ,_____,
15 _____,____,_____,_____,_____,_____,_____,_____,_____,_____,_____,←空白の行
16 京都 , 15 , c16 , d16 , e16 , f16 , g16 , h16 , i16 , j16 , k16 ,
17 京都 , 15 , c17 , d17 , e17 , f17 , g17 , h17 , i17 , j17 , k17 ,
18 京都 , 15 , c18 , d18 , e18 , f18 , g18 , h18 , i18 , j18 , k18 ,
19 京都 , 15 , c19 , d19 , e19 , f19 , g19 , h19 , i19 , j19 ,_____,
20 京都 , 15 , c20 , d20 , e20 , f20 , g20 , h20 , i20 , j20 ,_____,
21 京都 , 15 , c21 , d21 , e21 , f21 , g21 , h21 , i21 , j21 ,_____,
22 京都 , 15 , c22 , d22 , e22 , f22 , g22 , h22 , i22 , j22 ,_____,
23 京都 , 15 , c23 , d23 , e23 , f23 , g23 , h23 , i23 , j23 ,_____,
24 京都 , 15 , c24 , d24 , e24 , f24 , g24 , h24 , i24 , j24 ,_____,
25 京都 , 15 , c25 , d25 , e25 , f25 , g25 , h25 , i25 , j25 ,_____,
26 京都 , 15 , c26 , d26 , e26 , f26 , g26 , h26 , i26 , j26 ,_____,
27 京都 , 15 , c27 , d27 , e27 , f27 , g27 , h27 , i27 , j27 ,_____,
28 京都 , 15 , c28 , d28 , e28 , f28 , g28 , h28 , i28 , j28 ,_____,
29 京都 , 15 , c29 , d29 , e29 , f29 , g29 , h29 , i29 , j29 ,_____,
30 京都 , 15 , c30 , d30 , e30 , f30 , g30 , h30 , i30 , j30 ,_____,
31_____,____,_____,_____,_____,_____,_____,_____,_____,_____,_____,←空白の行
32 愛知 , 11 , c32 , d32 , e32 , f32 , g32 , h32 , i32 , j32 , k32 ,
33 愛知 , 11 , c33 , d33 , e33 , f33 , g33 , h33 , i33 , j33 , k33 ,
34 愛知 , 11 , c34 , d34 , e34 , f34 , g34 , h34 , i34 , j34 , k34 ,
35 愛知 , 11 , c35 , d35 , e35 , f35 , g35 , h35 , i35 , j35 ,_____,
36 愛知 , 11 , c36 , d36 , e36 , f36 , g36 , h36 , i36 , j36 ,_____,
37 愛知 , 11 , c37 , d37 , e37 , f37 , g37 , h37 , i37 , j37 ,_____,
38 愛知 , 11 , c38 , d38 , e38 , f38 , g38 , h38 , i38 , j38 ,_____,
39 愛知 , 11 , c39 , d39 , e39 , f39 , g39 , h39 , i39 , j39 ,_____,
40 愛知 , 11 , c40 , d40 , e40 , f40 , g40 , h40 , i40 , j40 ,_____,
41 愛知 , 11 , c41 , d41 , e41 , f41 , g41 , h41 , i41 , j41 ,_____,
42 愛知 , 11 , c42 , d42 , e42 , f42 , g42 , h42 , i42 , j42 ,_____,
43_____,____,_____,_____,_____,_____,_____,_____,_____,_____,_____,←空白の行
44



上記のようなデータがあり,これを【sheet2】に
   A  , B ,  d , D , E , F , G , H , I , J , K , L , M , N , O , …, R , …, V ,
1 地区 ,データ数,順位 , 1位,2位,3位,4位,5位,6位,7位, …, …, …, …, …, …, …, …, ……,
2    ,   , 項目1, d3, d4, d5, d6, d7, d8, d9,d10,d11,d12,d13,d14, …, …, …,項目7,
3    ,   , 項目2, e3, e4, e5, e6, e7, e8, e9,e10,e11,e12,e13,e14, …, …, …, j3 ,
4 東京 , 12 , 項目3, f3, f4, f5, f6, f7, f8, f9,f10,f11,f12,f13,f14, …, …, …,項目8,
5    ,   , 項目4, g3, g4, g5, g6, g7, g8, g9,g10,g11,g12,g13,g14, …, …, …, k3 ,
6    ,   , 項目5, h3, h4, h5, h6, h7, h8, h9,h10,h11,h12,h13,h14, …, …, …, k4 ,
7 ________,______, 項目6, i3, i4, i5, i6, i7, i8, i9,i10,i11,i12,i13,i14, …, …, …, k5 ,
8    ,   , 項目1, d16,d17,d18,d19,d20,d21,d22,d23,d24,d25, …, …, …,d30,___,項目7
9    ,   , 項目2, e16,e17,e18,e19,e20,e21,e22,e23,e24,e25, …, …, …,e30,___, j16 ,
10    ,   , 項目3, f16,f17,f18,f19,f20,f21,f22,f23,f24,f25, …, …, …,f30,___,項目8,
11 京都 , 15 , 項目4, g16,g17,g18,g19,g20,g21,g22,g23,g24,g25, …, …, …,g30,___, k16 ,
12    ,   , 項目5, h16,h17,h18,h19,h20,h21,h22,h23,h24,h25, …, …, …,h30,___, k17 ,
13 _______,______, 項目6, i16,i17,i18,i19,i20,i21,i22,i23,i24,i25, …, …, …,i30,___, k18 ,
14    ,   , 項目1, d32,d33,d34,d35,d36,d37,d38,d39,d40,d41,d42, …, …, …, …,項目8,
15    ,   , 項目2, e32,e33,e34,e35,e36,e37,e38,e39,e40,e41,e42, …, …, …, …, j32,
16    ,   , 項目3, f32,f33,f34,f35,f36,f37,f38,f39,f40,f41,f42, …, …, …, …,項目9,
17 愛知 , 11 , 項目4, g32,g33,g34,g35,g36,g37,g38,g39,g40,g41,g42, …, …, …, …, k32 ,
18    ,   , 項目5, h32,h33,h34,h35,h36,h37,h38,h39,h40,h41,h42, …, …, …, …, k33 ,
19 _______,_____, 項目6, i32,i33,i34,i35,i36,i37,i38,i39,i40,i41,i42, …, …, …, …, k34 ,




というように表示させるために、下記のようにコードを書いたのですが,
望んでいる結果が得られません.
------------------------------------------------------------------------
Sub コピペ()

i = 2
j = 2

m = 2
n = 3
o = 4
p = 5
q = 6
r = 7

p01:
Application.DisplayAlerts = False
If Cells(i, "A") = "" Then
   Sheets(1).Cells(i + 1, "A").Copy Sheets(2).Cells(j, "A")
   Sheets(2).Range(Cells(j, "A"), Cells(j + 5, "A")).MergeCells = True
  
   Sheets(1).Cells(i + 1, "B").Copy Sheets(2).Cells(j, "B")
   Sheets(2).Range(Cells(j, "B"), Cells(j + 5, "B")).MergeCells = True

   Sheets(1).Cells(i + 1, "J").Copy Sheets(2).Cells(j + 1, "V")
   Sheets(1).Cells(i + 1, "K").Copy Sheets(2).Cells(j + 3, "V")
   Sheets(1).Cells(i + 2, "K").Copy Sheets(2).Cells(j + 4, "V")
   Sheets(1).Cells(i + 3, "K").Copy Sheets(2).Cells(j + 5, "V")
     
   j = j + 6

ElseIf Cells(i, "A") <> "" Then
   Y = Cells(i, "B").Value
  
   Sheets(1).Range(Cells(i, "D"), Cells(i + Y - 1, "D")).Copy Sheets(2).Range(Cells(m, 4), Cells(m, 4 + Y))←「型が違います」と表示され処理ができない.
   m = m + 6
   Sheets(1).Range(Cells(i, "E"), Cells(i + Y - 1, "E")).Copy Sheets(2).Range(Cells(n, 4), Cells(n, 4 + Y))
   n = n + 6
   Sheets(1).Range(Cells(i, "F"), Cells(i + Y - 1, "F")).Copy Sheets(2).Range(Cells(o, 4), Cells(o, 4 + Y))
   o = o + 6
   Sheets(1).Range(Cells(i, "G"), Cells(i + Y - 1, "G")).Copy Sheets(2).Range(Cells(p, 4), Cells(p, 4 + Y))
   p = p + 6
   Sheets(1).Range(Cells(i, "H"), Cells(i + Y - 1, "H")).Copy Sheets(2).Range(Cells(q, 4), Cells(q, 4 + Y))
   q = q + 6
   Sheets(1).Range(Cells(i, "I"), Cells(i + Y - 1, "I")).Copy Sheets(2).Range(Cells(r, 4), Cells(r, 4 + Y))
   r = r + 6
  
Else
End If
i = i + 1
Application.DisplayAlerts = True
GoTo p01
End Sub
------------------------------------------------------------------------

どのように書き換えれば,望んだ結果が得られるでしょうか?
アドバイスをお願いします.

0 hits

【72481】sheet1のデータをsheet2に整形して抽出する方法 タケル 12/8/15(水) 14:45 質問
【72484】Re:sheet1のデータをsheet2に整形して抽出... UO3 12/8/15(水) 19:54 発言
【72487】Re:sheet1のデータをsheet2に整形して抽出... タケル 12/8/15(水) 22:17 回答
【72488】Re:sheet1のデータをsheet2に整形して抽出... タケル 12/8/15(水) 22:36 お礼
【72496】Re:sheet1のデータをsheet2に整形して抽出... kanabun 12/8/16(木) 9:28 発言
【72501】Re:sheet1のデータをsheet2に整形して抽出... UO3 12/8/16(木) 15:57 発言
【72490】Re:sheet1のデータをsheet2に整形して抽出... UO3 12/8/15(水) 22:40 発言

9812 / 76736 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free