[[20151127170757]] 『データを別シートに1行おきに連続して自動コピーax(パピオ) ページの最後に飛ぶ

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

 

『データを別シートに1行おきに連続して自動コピーしたい』(パピオ)

excelの住所録データの印刷用シートを作るにあたって、必要な項目だけ印刷用シートに自動で
入るようにしたいが、住所欄だけ住所1、住所2を2行に分けたい。
 したがって氏名、郵便番号、電話などは1行しか使わないが2行分を使い、3行目、4行目にレコド2のデータがコピーできるようにしたい。

 例
 sheeti

  1 氏名 郵便番号 住所1 住所2 電話番号  備考
  2 氏名 郵便番号 住所1 住所2 電話番号

  sheet2(印刷用

  1 氏名 郵便番号 住所1 電話番号
            住所2

    2 氏名 郵便番号 住所1 電話番号
            住所2     
というようにしたいのです

< 使用 Excel:Excel2003、使用 OS:Windows7 >


 VBA案です。
 関数がご希望なら関数の回答をお待ちください。

 Sub Test()
    Dim w As Variant
    Dim x As Long
    Dim c As Range

    With Sheets("Sheet1")       '元シート
        With .Range("A1", .Range("A" & Rows.Count).End(xlUp))
            ReDim w(1 To .Rows.Count * 2, 1 To 4)
            For Each c In .Cells
                x = x + 1
                w(x, 1) = c.Value
                w(x, 2) = c.Offset(, 1).Value
                w(x, 3) = c.Offset(, 2).Value
                w(x, 4) = c.Offset(, 4).Value
                x = x + 1
                w(x, 3) = c.Offset(, 3).Value
            Next
        End With
    End With

    With Sheets("Sheet2")       '転記シート
        .UsedRange.ClearContents
        .Range("A1").Resize(UBound(w, 1), UBound(w, 2)).Value = w
        .Select
    End With

 End Sub

(β) 2015/11/27(金) 18:49


 「自動で」というところが、ちょっと悩みますけど、
 Sheet2 の シートモジュール(シートタブを右クリックしてコードの表示を選んででてくるところ)に以下を貼り付けると
 SHeet2 を【開くと】自動転記されます。
 (Sheet1にデータを入れた時点では反映しませんが)

 Private Sub Worksheet_Activate()
    Dim w As Variant
    Dim x As Long
    Dim c As Range

    With Sheets("Sheet1")       '元シート
        With .Range("A1", .Range("A" & Rows.Count).End(xlUp))
            ReDim w(1 To .Rows.Count * 2, 1 To 4)
            For Each c In .Cells
                x = x + 1
                w(x, 1) = c.Value
                w(x, 2) = c.Offset(, 1).Value
                w(x, 3) = c.Offset(, 2).Value
                w(x, 4) = c.Offset(, 4).Value
                x = x + 1
                w(x, 3) = c.Offset(, 3).Value
            Next
        End With
    End With

    UsedRange.ClearContents
    Range("A1").Resize(UBound(w, 1), UBound(w, 2)).Value = w

 End Sub

(β) 2015/11/27(金) 19:27


お二人ともありがとうございました。
できれば関数をシート2に書き込んでおきシート1でデータくぉ書き込んだり編集したりしたものがシート2に
反映したいのですが
(パピオ) 2015/11/27(金) 19:54

 >>お二人とも

 レスしているのは今のところβだけです。

 で、関数は苦手で、超ダサイんですが、Sheet2の

 A1: =IF(INDEX(Sheet1!$A:$A,QUOTIENT(ROW()-1,2)+1)="","",INDEX(Sheet1!$A:$A,QUOTIENT(ROW()-1,2)+1))
 B1: =IF(INDEX(Sheet1!$A:$A,QUOTIENT(ROW()-1,2)+1)="","",INDEX(Sheet1!$B:$B,QUOTIENT(ROW()-1,2)+1))
 C1: =IF(INDEX(Sheet1!$A:$A,QUOTIENT(ROW()-1,2)+1)="","",INDEX(Sheet1!$C:$C,QUOTIENT(ROW()-1,2)+1))
 D1: =IF(INDEX(Sheet1!$A:$A,QUOTIENT(ROW()-1,2)+1)="","",INDEX(Sheet1!$E:$E,QUOTIENT(ROW()-1,2)+1))
 C2: =IF(INDEX(Sheet1!$A:$A,QUOTIENT(ROW()-1,2)+1)="","",INDEX(Sheet1!$D:$D,QUOTIENT(ROW()-1,2)+1))

 で、A1:D2 を選択して、そのまま下にズリズリフィルコピーすれば、一応転記はされると思います。

 スマートな回答は、早晩専門家さんから。

(β) 2015/11/27(金) 21:03


 5列程度のことなら「置換」でやると簡単。

 ところでSheet1の郵便番号と電話番号は、数値? 文字列?

 一応文字列で、Sheet1もSheet2も、1行目は見出し、2行目からデータだとして

 A2: #sheet1!a2&""
 B2: #sheet1!b2&""
 C2: #sheet1!c2&""
 D2: #sheet1!e2&""

 C3: #sheet1!d2&""

 と入力(先頭はイコールではない)

 A2:D3 を選択して下にフィルコピー

 コピーした範囲が選択された状態で、Ctrl+H(置換)

 検索する文字列: #
 置換後の文字列: =
 
「すべて置換」をクリックで完成。
 
  
 Sheet1の郵便番号とかが数値であり、表示形式で 000-0000 などとしている場合は

 B2 #sheet1!b2 ←「&""」を付けない。

 B2の表示形式をユーザー定義で 000-0000;; ← 「;;」を付ける

 電話番号も数値なら同様にして、コピー&置換を実行。

 こんな感じ。
(笑) 2015/11/28(土) 16:11

 あぁ、 =セル&"" ですね!!
 で、Sheet1 も Sheet2 も1行目がタイトル行でデータが2行目からあるなら、βがアップしたものは

 Sheet2 の

 A2: =INDEX(Sheet1!$A:$A,QUOTIENT(ROW()-2,2)+2)
 B2: =INDEX(Sheet1!$B:$B,QUOTIENT(ROW()-2,2)+2)
 C2: =INDEX(Sheet1!$C:$C,QUOTIENT(ROW()-2,2)+2)
 D2: =INDEX(Sheet1!$E:$E,QUOTIENT(ROW()-2,2)+2)
 C3: =INDEX(Sheet1!$D:$D,QUOTIENT(ROW()-2,2)+2)

 で、Sheet2 の A2:D3 を選択して、下にずずずっとフィルコピー に変えましょう。

(β) 2015/11/28(土) 19:40


 > 1 氏名 郵便番号 住所1 電話番号 
 >           住所2 

 左端の数字はレコード番号?
 これも Sheet2 に表示させたいのかな?

 前の回答は

 A列  B列    C列  D列  E列
 氏名  郵便番号 住所1 住所2 電話番号

 という想定なので、そのつもりで読み替えてください。

 で、A列がレコード番号なら、それは数値でしょうから

 A2: #sheet1!a2 ← 「&""」を付けない

 A2の表示形式をユーザー定義で # にする。

 こんな感じ。
(笑) 2015/11/28(土) 23:44

コメント返信:

[ 一覧(最新更新順) ]


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