[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『データの並び替え・編集』(ごん)
<実施したいこと>
マクロを使用して、以下【1】のようなファイルを、【2】のような形式に編集したいです。
***********************
【1】
A B C D ……
1 氏名イ 番号1 番号2 番号3
2 氏名ロ 番号2
3 氏名ハ 番号3 番号5
…
***********************
【2】
A B
1 氏名イ 番号1
2 氏名イ 番号2
3 氏名イ 番号3
4 氏名ロ 番号2
5 氏名ハ 番号3
6 氏名ハ 番号5
…
***********************
<詳細>
【1】
・A列に入力されている氏名は、間に空白なく、下に続きます。
(最終行は固定ではない)
・B列より右に入力されている番号は、間に空白なく、右に続きます。
(最終列は固定ではない)
・行(氏名)ごとに最終列(番号x)は変わります。
【2】
・A列:氏名、B列:番号xとしたい。
・【1】の別シートへの出力でも、新規ブックへの出力でも可
< 使用 Excel:Excel2016、使用 OS:Windows10 >
Sub test() Dim r As Range, RWs, Data(), CL As Long Dim i As Long, idx As Long
Set r = ActiveSheet.Range("A1").CurrentRegion RWs = Application.CountA(r.Offset(, 1))
ReDim Data(1 To RWs, 1 To 2)
For i = 1 To RWs For CL = 2 To r.Columns.Count If r(i, CL) <> "" Then idx = idx + 1 Data(idx, 1) = r(i, 1) Data(idx, 2) = r(i, CL) End If Next CL Next i
With Worksheets.Add .Name = "New" .Range("A1").Resize(RWs, 2) = Data End With End Sub
(半平太) 2020/05/23(土) 17:46
> For i = 1 To RWs > ↓ > For i = 1 To r.Rows.Count
ご指摘ありがとうございます。 (あら? 消えている・・)
以下改訂版
Sub test() Dim r As Range, RWs, Data(), CL As Long Dim i As Long, idx As Long
Set r = ActiveSheet.Range("A1").CurrentRegion RWs = Application.CountA(r.Offset(, 1))
ReDim Data(1 To RWs, 1 To 2)
For i = 1 To r.Rows.Count For CL = 2 To r.Columns.Count If r(i, CL) <> "" Then idx = idx + 1 Data(idx, 1) = r(i, 1) Data(idx, 2) = r(i, CL) Else Exit For End If Next CL Next i
With Worksheets.Add .Name = "New" .Range("A1").Resize(RWs, 2) = Data End With End Sub
(半平太) 2020/05/23(土) 19:52
(は) 2020/05/23(土) 19:54
は様
ご連絡ありがとうございました。
やはり、は様のメッセージ、私からも閲覧することができません。。
ただ、おかげさまで希望の動作が実行できました。
大変助かりました。
(ごん) 2020/05/23(土) 22:38
【1】の番号xに「0001」のような番号があった場合、
【2】で「1」と表示されてしまいます。
【2】に文字列で出力し、「0001」と表示させる場合どのようにしたら良いでしょうか。
(ごん) 2020/05/24(日) 11:46
> With Worksheets.Add > .Name = "New" > .Range("A1").Resize(RWs, 2) = Data > End With
With Worksheets.Add .Name = "New" .Range("A1").Resize(RWs, 2).NumberFormatLocal = "G/標準;@" '←1行追加挿入 .Range("A1").Resize(RWs, 2) = Data End With
(半平太) 2020/05/24(日) 11:57
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.