質問: vba詳しい方お願いします vbaに詳しい方お願いします。 a列 b列 c列 d列 e列 f列 g列 h列 i列 j列... 1 1 010 a ab 2 1 010 a 春 夏 秋 冬 3 1 010 a 上 下 4 2 020 b bc 5 2 020 b 花 6 2 020 b 陸 空 : : ↑を↓に変える記述教えてください。。 a列 b列 c列 d列 e列 f列 g列 h列 i列 j列... 1 1 010 a ab 2 1 010 a 春 3 1 010 a 夏 4 1 010 a 秋 5 1 010 a 冬 6 1 010 a 上 7 1 010 a 下 8 2 020 b bc 9 2 020 b 花 10 2 020 b 陸 11 2 020 b 空 : : やり方はなんでもいいのですが、 例えば e1に値が入っていないのでカーソルを下に移動(e2へ移動) e2に値が入っているのでカーソルを右に移動(f2へ移動) f2に値が入っているので下(3行目)に新しい行を挿入し、(a2,b2,c2) を コピーして、(a3,b3,c3)に貼り付け、f2を切り取りe3に貼り付け る これをf2、g2、h2と繰り返してi2で空欄が出るまで続ける。 e8に値が入っていないのでカーソルを下に移動(e9へ移動) : :
回答: こんにちは。 方法は色々あると思いますが、以下の方法では如何でしょうか。 但し、d列に展開される文字列は半角、e列に展開される文字列は全角として考えた場合です。 sub 文字展開() dim rowmax as long dim wrow as long dim wcol as integer dim editrow as long dim wstr as string dim sht2 as worksheet ' set sht2 = worksheets("sheet2") sht2.cells.clearcontents editrow = 0 with activesheet wrowmax = .range("a" & rows.count).end(xlup).row for wrow = 1 to wrowmax wstr = left(.cells(wrow, 4), 1) if len(wstr) = lenb(strconv(wstr, vbfromunicode)) then '必ず、半角文字 editrow = editrow + 1 sht2.cells(editrow, 1) = .cells(wrow, 1) sht2.cells(editrow, 2) = .cells(wrow, 2) sht2.cells(editrow, 3) = .cells(wrow, 3) sht2.cells(editrow, 4) = .cells(wrow, 4) else '必ず、全角文字 for wcol = 4 to 256 if .cells(wrow, wcol) = "" then exit for end if editrow = editrow + 1 sht2.cells(editrow, 1) = .cells(wrow, 1) sht2.cells(editrow, 2) = .cells(wrow, 2) sht2.cells(editrow, 3) = .cells(wrow, 3) sht2.cells(editrow, 5) = .cells(wrow, wcol) next end if next end with end sub