ＶＢＡ詳しい方お願いします

質問

VBAに詳しい方お願いします。

　Ａ列　Ｂ列　Ｃ列　Ｄ列　Ｅ列　Ｆ列　Ｇ列　Ｈ列　Ｉ列　Ｊ列…
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　　　　　　陸　　空
:
:
↑を↓に変える記述教えてください。。

　Ａ列　Ｂ列　Ｃ列　Ｄ列　Ｅ列　Ｆ列　Ｇ列　Ｈ列　Ｉ列　Ｊ列…　
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へ移動)
：
：

回答No.1

pkh4989 · ベストアンサー

こんにちは。
方法は色々あると思いますが、以下の方法では如何でしょうか。
但し、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

お礼

回答ありがとうございます！さっそく実行してみたのですが
「マクロが使用できません。セキュリティ レベルが高に設定されています。また、デジタル署名された信頼された証明書がマクロに添付されていません。～～」となってしまいます。
セキュリティレベルを中にしても同じエラーが出ます。
証明書は持っていません。。ていうかよくわかりません。。
どうしたらいいのでしょうか？？？

回答No.3

pkh4989

こんにちは。 No.1です。
Officeのデジタル署名に関するコンポーネントがインストールされていないかも知りません。
Officeを完全インストールしてみてください。

回答No.2

n-jun

マクロが使用できません。助けてください。
http://oshiete1.goo.ne.jp/qa3032582.html?ans_count_asc=20
この事では？