[[20200523164644]] 『データの並び替え・編集』(ごん) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『データの並び替え・編集』(ごん)

<実施したいこと>
マクロを使用して、以下【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


昨日に続いて、早速のご回答ありがとうございます。
希望通り、「0001」のような形式で出力されること確認できました。
大変助かりました。ありがとうございます。
(ごん) 2020/05/24(日) 12:05

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.