[[20151026162019]]　『データ転記について』（すん）　ページの最後に飛ぶ

『データ転記について』（すん）

データ転記方法についてアドバイスお願いします。

シート1のA列に氏名が100行くらい入力されています。
シート2に雛形があり、一つの雛形に5名まで氏名が入るようになっているのですが、
シート1に氏名が入力されてるぶんだけ、雛形に転記していき、5名を超えたら新たに雛形シートを作り残りを転記していく、という動作をしたいのですが、
やはりVBAでの作業になりますか？？

もしよければ、コードのヒント等を教えて下さい。

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

 マクロ不要です。

 既にひな形(=Sheet2)に5名分氏名が転記されるようになっている様ですけど、
 １．その転記する為に書かれた数式を「ｘ行目から5名転記する」ものに変更する。

 　※　ｘは、Sheet名に番号を入れるルールにして、そこから逆算できるようにする。
 　　　例．Sheet01なら(01-1)*5+1で1行目から5名転記、
 　　　　　Sheet02なら(02-1)*5+1で6行目から5名転記

 ２．以上が済んだら、ひな形を20枚コピーし、
 　　それぞれのシート名をShee01、Sheet02・・・Sheet19、Sheet20 と変えれば完了。

 シート名の右２桁を切り取る関数は(↓）。

 =RIGHT(REPLACE(CELL("filename",A1),1,FIND("]",CELL("fileName",A1)),""),2)

 　ブックを一回は保存してないと上の関数は作動しません。(新規ブックではエラーになります）

（半平太） 2015/10/26(月) 17:14

半平太さま

ごめんなさい、雛形(シート2)には転記するような数式はいれてないのですが、
例の数式がよく分かりません。
理解力がなくてすみません。
もうすこし説明していただけませんか？？
（すん） 2015/10/26(月) 18:11

 ＞ごめんなさい、雛形(シート2)には転記するような数式はいれてないのですが、

 入れてない？ すると、この「入るようになっている」と云うのは、空のセルってこと？
 　　　　　　 　　　　　　　↓
 ＞一つの雛形に5名まで氏名が入るようになっているのですが

 でしたら、雛形に転記すると云うことはしません。
 雛形シートをコピーして、そっちに5名ずつ入れて行く
 (雛形は、まっさらな状態で温存するのが普通です）。

 ヒントと云う事で・・・
 　↓
Sub nameShift()
    Dim wsNames As Worksheet, wsBlank As Worksheet, wsNew As Worksheet
    Dim oneOfNames As Range, NN As Long, posToWrite As Long
    Dim isFirst As Boolean, endOfJob  As Boolean

    Set wsNames = Sheets("Sheet1")
    Set wsBlank = Sheets("雛形")

    For NN = 0 To 300 Step 5
        isFirst = True
        posToWrite = 0

        For Each oneOfNames In wsNames.Range("A2:A6").Offset(NN).Cells
            If Not IsEmpty(oneOfNames) Then
                posToWrite = posToWrite + 1
                If isFirst Then         '第1氏名
                    isFirst = False     '第2氏名以降に備える
                    wsBlank.Copy After:=Worksheets(Worksheets.Count)      '雛形をコピーする
                    Set wsNew = Worksheets(Worksheets.Count)
                    wsNew.Cells(posToWrite, "B").Value = oneOfNames.Value 'B1セルに名前を書き出す
                Else '第2氏名以降
                    wsNew.Cells(posToWrite, "B").Value = oneOfNames.Value '前回の下に名前を書き出す
                End If
            Else
                endOfJob = True
            End If
        Next

        If endOfJob Then
            Exit For
        End If

    Next NN
End Sub

（半平太） 2015/10/26(月) 20:21

半平太さま

大変遅れまして申し訳ございません！
作って頂いたコードで無事作動致しました。
誠にありがとうございます！
（すん） 2015/10/28(水) 22:05

コメント返信：

[ 一覧(最新更新順) ]

[[20151026162019]] 『データ転記について』（すん） ページの最後に飛ぶ

[[20151026162019]]　『データ転記について』（すん）　ページの最後に飛ぶ