[[20151126114217]]　『Excelの表の書き換えに苦戦しています。』（たけぼう）　ページの最後に飛ぶ

『Excelの表の書き換えに苦戦しています。』（たけぼう）

いつもお世話になっています。
先日整理番号の振り方について教えて頂いたのですが、
今度はその表の書き換えができないかと奮闘しています。
＜現在の表＞から＜書き換えたい表＞の様に書き換えるということは、Excelの仕様として可能なのでしょうか。
教えて頂けたら幸いです。

＜現在の表＞
A B C D E F
会員番号氏名整理No1 整理No2 整理No3 整理No4
000011 藤本太郎　　１　　　　２　　　　３　　　　４
000012 新井花子　　５　　　　６
000013 小林ゆうじ７
000014 宮沢さちこ８　　　９
000015 小池けんじ１０　１１

↓
＜書き換えたい表(レイアウトがいまいち見にくくてすみません)＞
A 　 B　　　　　　 C
会員番号　氏名　　　　　整理No
000011 藤本太郎　　１
000011 同伴者　　 2
000011 同伴者　　3
000011 同伴者　　4
000012 新井花子　　５
000012 同伴者　　６
000013 小林ゆうじ　　７
000014 宮沢さちこ　　８
000014 同伴者　　９
000015 小池けんじ１０
000015 同伴者　　　１１

＜使用アプリ：Excel2011(Mac)、使用 OS：MacOSX ＞

標準機能にはそんな複雑なものは無いので、マクロで実現しましょう。

 Sub test()
    Dim i As Long
    Dim j As Long
    Dim iR As Long

    iR = 1
    Sheet2.Range("A1:C1") = Array("会員番号", "氏名", "整理No")

    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        For j = 3 To Cells(i, Columns.Count).End(xlToLeft).Column
            iR = iR + 1
            Sheet2.Cells(iR, "A").Value = Cells(i, "A").Value
            If j = 3 Then
                Sheet2.Cells(iR, "B").Value = Cells(i, "B").Value
            Else
                Sheet2.Cells(iR, "B").Value = "同伴者"
            End If
            Sheet2.Cells(iR, "C").Value = Cells(i, j).Value
        Next j
    Next i
 End Sub
（???） 2015/11/26(木) 12:55

（???）さん

ご返答ありがとうございます。
早速マクロを書いてみたんですが、

 Range("A1:C1") = Array("会員番号", "氏名", "整理No ")　で止まってしまいます。

何かいい方法はありませんでしょうか？
よろしくお願いします。
（たけぼう） 2015/11/26(木) 13:12

 関数で行う場合。
 作業列も使う。
 現在の表をSheet1とする。

 現在の表のG2セルに
 =IF(A2="","",COUNTA(C$2:F2))
 と入力して下へフィルコピー。

 書き換えたい表シートの
 A2セル:=INDEX(Sheet1!A$2:A$100,MATCH(1,INDEX((Sheet1!G$2:G$100>=ROW(A1))*1,0),0))&""
 B2セル:=IF(A2="","",IF(A1=A2,"同伴者",VLOOKUP(A2,Sheet1!A$2:B$100,2,FALSE)))
 C2セル:=IFERROR(VLOOKUP(A2,Sheet1!A$2:F$100,COUNTIF(A$2:A2,A2)+2,FALSE),"")
 と入力して下へフィルコピー。
（ねむねむ） 2015/11/26(木) 13:32

（ねむねむ）さん

ありがとうございます。
教えて頂いた通りにやってみました。
出来ました。

なかなか全部理解ができないので、頑張って読み解いて、次に行かせるようにします！
（たけぼう） 2015/11/26(木) 14:03

 COUNTAでできたってことは、整理ナンバーのところは数式じゃないってこと？
 ならばそこが数値だとして。

 関数で行う場合、その2

 ■現在の表（Sheet1）　G列を作業列にする
 G1 =COUNT(C2:F100)
 G2に　1　を手入力

 G3 =G2+COUNT(C2:F2)　　下へコピー

 ■書き換えたい表
 A2 =IF(Sheet1!$G$1<ROW(A1),"",LOOKUP(ROW(A1),Sheet1!$G$2:$G$100,Sheet1!$A$2:$A$100))

 B2 =IF(A2="","",IF(A2=A1,"同伴者",VLOOKUP(A2,Sheet1!$A$2:$B$100,2,FALSE)))

 C2 =IF(A2="","",N(C1)+1)

 下コピー

 こんな感じ？
（笑） 2015/11/26(木) 14:38

 もう見てないかもしれないけど、こういうことかな（???さんのコードを一部変えたものです）

 Sub test()

    Dim i As Long
    Dim j As Long
    Dim iR As Long

    iR = 1
    Sheet2.Range("A1:C1") = Array("会員番号", "氏名", "整理No")

    With Sheets("Sheet1")
         For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
             For j = 3 To .Cells(i, Columns.Count).End(xlToLeft).Column
                 iR = iR + 1
                 Sheet2.Cells(iR, "A").Value = .Cells(i, "A").Value
                 If j = 3 Then
                    Sheet2.Cells(iR, "B").Value = .Cells(i, "B").Value
                Else
                    Sheet2.Cells(iR, "B").Value = "同伴者"
                End If
                Sheet2.Cells(iR, "C").Value = .Cells(i, j).Value
            Next j
        Next i
    End With

 End Sub
（se_9） 2015/11/26(木) 15:24

（笑）さん
コメントありがとうございます。
数式部分は先に数値に直しておりました。

 C2 =IF(A2="","",N(C1)+1)
のところだと、既に付番されている番号が抽出されないのでだめでした。

（se_9）さん
ありがとうございます。
何度も見返してます。実は。
コードを１つ１つ分解してgoogle先生で調べては「あぁそういう意味で使うのか」とかやってます。
でもマクロは調べても、使える気が全くしないです。難しい。

で、早速書き込んでみたんですが、

    Sheet2.Range("A1:C1") = Array("会員番号", "氏名", "整理No")

ここでデバックがでちゃうんです。
シンプルな所なのに、なんでなんだろうかと、、、、？？？です。

（たけぼう） 2015/11/26(木) 16:26

 エラー番号やエラーメッセージはなんだろうか？
（ねむねむ） 2015/11/26(木) 16:28

 うっかり見過ごしていた。

 Sheet2.Range("A1:C1") = Array("会員番号", "氏名", "整理No")
 を
 WorkSheets("Sheet2").Range("A1:C1") = Array("会員番号", "氏名", "整理No")
 ではどうだろうか？

 ＃なぜシート名指定（Sheets("Sheet1")）とオブジェクト名指定（Sheet2）を混ぜてるのだろうか？

 追記
 >Sheet2.Range("A1:C1") = Array("会員番号", "氏名", "整理No")
 だけでなくすべての「Sheet2.」表記を「WorkSheets("Sheet2").」として見てくれ。

（ねむねむ） 2015/11/26(木) 16:35

 エラーってもしかして

 実行時エラー 424
 オブジェクトが必要です

 ですか？もしそうなら原因は何となく特定できますが、ねむねむさんが書かれているように
 シート名を指定すればこのようなエラーはでないと思います。
（se_9） 2015/11/26(木) 16:54

（ねむねむ）さん
何度もありがとうございます。やはりエラーがでてしまいます。うーん。

 WorkSheets("Sheet2").Range("A1:C1") = Array("会員番号", "氏名", "整理No")　←実行時エラー９
（たけぼう） 2015/11/26(木) 17:01

 Sheet2というシート名が存在しないということはないですよね？
（se_9） 2015/11/26(木) 17:07

（se_9）さん
あわわ。シートが勝手に作られると勘違いしていました。
下記追加したら問題なく進みました！
根気よくおつきあいありがとうございます！応用が出来る様、復習頑張ります。

 Sub test()
    Dim i As Long
    Dim j As Long
    Dim iR As Long
    Dim NewWorkSheet As Worksheet
    Set NewWorkSheet = Worksheets.Add()
    NewWorkSheet.Name = "Sheet2"

    iR = 1
   Worksheets("Sheet2").Range("A1:C1") = Array("会員番号", "氏名", "整理No")
    With Sheets("Sheet1")
         For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
             For j = 3 To .Cells(i, Columns.Count).End(xlToLeft).Column
                 iR = iR + 1
                 Worksheets("Sheet2").Cells(iR, "A").Value = .Cells(i, "A").Value
                 If j = 3 Then
                    Worksheets("Sheet2").Cells(iR, "B").Value = .Cells(i, "B").Value
                Else
                    Worksheets("Sheet2").Cells(iR, "B").Value = "同伴者"
                End If
                 Worksheets("Sheet2").Cells(iR, "C").Value = .Cells(i, j).Value
            Next j
        Next i
    End With
 End Sub

（たけぼう） 2015/11/26(木) 17:17

コメント返信：

[ 一覧(最新更新順) ]

[[20151126114217]] 『Excelの表の書き換えに苦戦しています。』（たけぼう） ページの最後に飛ぶ

[[20151126114217]]　『Excelの表の書き換えに苦戦しています。』（たけぼう）　ページの最後に飛ぶ