エクセルのマクロで教えてください

質問

excelのマクロで２つお伺いします

１．右のセルの内容を下に移す

Ａ　１　２　３　４
Ｂ　３　４　６

を
Ａ　１
Ａ　２
Ａ　３
Ａ　４
Ｂ　３
Ｂ　４
Ｂ　６

メニューから下に何行か行を挿入して
おいて特殊ペーストで行列を
いれかえるとすればできたのですが
何通りもある場合マクロを使って
できないでしょうか

２．リレーショナルへの対応

Ａ　１　２
Ｂ　２　３　４

１　あ　う
２　い
３　お
４　か　き

左側１列目は右に続く（個数不定）記号を
もっているとして１番目（Ａ、、）
２番目（１、、）、３番目（あ、、）を
結び付けたいのです

上の例ですと

Ａ　あ　う　い
Ｂ　い　お　か　き

をマクロで出力できますでしょうか

ご存知の方いらっしゃいましたら
教えてください。よろしくお願いします。

回答No.1

imogasi · ベストアンサー

前半の回答例
Sub test01()
Dim cl As Range
i = 1
For Each cl In Selection
If cl = "" Then
Else
Cells(i, "G") = cl
i = i + 1
End If
Next
End Sub
（１）元データを範囲指定して、実行してください。
（２）ボタンなどを貼りつけ、クリックイベントと
関連づけて下さい（略）
（３）セット先の列を決めるのは、ＩＮＰＵＴＢＯＸででも策を考えて下さい（略）。上記コードではＧ列と仮定している。スタートも第１行からになっていますので指定できるように考えてください。

お礼

ありがとうございます。実行できました。応用を考えてみます

回答No.3

sakenomo

＃２です。

記入漏れです。

もうひとつの前提として、参照元データのセル範囲は
セルＡ１を使う必要があります。
（質問例だと、セルＡ１に、Ａが入る）

回答No.2

sakenomo

後半の回答例です。

新しいシートを挿入して結果を出力します。

なお、このマクロは以下の前提で書きました。

参照元、参照先のデータに隣接するセルは空白
参照元の番号は必ず参照先にある

Sub test()
Dim myRng As Range, Trng As Range, Ws As Worksheet
Dim i As Integer, c As Range

Set myRng = Range("A1").CurrentRegion
Set Ws = ActiveSheet

ActiveWorkbook.Sheets.Add
myRng.Columns(1).Copy Destination:=Range("A1")

Set Trng = Range("B1")
i = 2
With Application.WorksheetFunction
For Each c In myRng.Offset(0, 1)
If c.Value <> "" Then
p = .Match(c.Value, Ws.Columns(1), 0)
If c.Row > Trng.Row Then
Set Trng = Cells(c.Row, 2)
End If
Do
Trng.Value = .Index(Ws.Rows(p), 1, i)
If Trng.Value <> "" Then
Set Trng = Trng.Offset(0, 1)
i = i + 1
Else
i = 2
Exit Do
End If
Loop
End If
Next
End With
End Sub

お礼

実行できました。ありがとうございます。こちらもマクロを読んで応用ができるようにしたいと思っています。どちらの方にも20点いれさせていただきたかったのですがシステム上できないので順番にして終了いたします