[[20170521072132]]　『判定番号により転記列を変えたい』（ふみか）　ページの最後に飛ぶ

『判定番号により転記列を変えたい』（ふみか）

初めまして。
マクロ初心者につきご教示願います。
「元データ」シート

　　　Ａ　Ｂ　　　Ｃ　　　Ｄ　　Ｅ　Ｆ　Ｇ　Ｈ　Ｉ　Ｊ　Ｋ
１　判定　項目　　単位　　数量
２　　１　データ
３　　２　データ
４　　３　データ
５　　４　データ
６　　５　データ
７　　２　データ
８　　３　データ
９　　４　データ
１０　５　データ
１１　５　データ
１２　５　データ

「編集後」シート

　判定が、１ならＢへ
　　　　　２ならＣへ
　　　　　３ならＤへ
　　　　　４ならＥへ
　　　　　５ならＦへ

          それに、伴いＣはＧへ
　　　　　　　　　　　ＤはＨへ
　と、転記していきたいです。

　　　Ａ　Ｂ　　Ｃ　Ｄ　Ｅ　Ｆ　Ｇ　　Ｈ　Ｉ　Ｊ　Ｋ
１　　　　項目　　　　　　　　　　単位　数量
２　　　　データ
３　　　　　　　　　データ
４　　　　　　　　　　　　データ
５　　　　　　　　　　　　　　データ
６　　　　　　　　　　　　　　　データ
７　　　　　　　　　　　データ
８　　　　　　　　　　　　データ
９　　　　　　　　　　　　　　データ
１０　　　　　　　　　　　　　　データ
１１　　　　　　　　　　　　　　データ
１２　　　　　　　　　　　　　　データ

と、したいのです。
宜しくお願い致します。

現状は、Ｂに全部データがあるのですが分かりにくいから
変更してほしいと言われました。
１０００件ほどあるので手作業でやっていたら日曜日が終わってしまうので
宜しくお願い致します。

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

 　　　Ａ　Ｂ　　　Ｃ　　Ｄ　　Ｅ　　Ｆ　　Ｇ　　 Ｈ　　Ｉ　Ｊ　Ｋ 
 １　　　　項目　　　　　　　　　　　　　　単位　数量 
 ２　　　　データ 
 ３　　　　 　　　データ 
 ４　　　　 　　　　　　データ 
 ５　　　　 　　　　　　　　　データ 
 ６　　　　 　　　　　　　　　　　　データ 
 ７　　　　 　　　データ 
 ８　　　　 　　　　　　データ 
 ９　　　　 　　　　　　　　　データ 
 １０　　　 　　　　　　　　　　　　データ 
 １１　　　 　　　　　　　　　　　　データ 
 １２　　　 　　　　　　　　　　　　データ

整形方法が、分かったので投稿しなおししてみました。
（ふみか） 2017/05/21(日) 07:48

手作業ならどうしますか。
その手順を箇条書きで整理し、
マクロはその後で考えるとよいです。

（マナ） 2017/05/21(日) 09:05

 マクロでやりたいんですかね？
 数式なら ベタベタですけど

 B2 : =IF(元データ!$A2="","",IF(元データ!$A2=COLUMN(A1),元データ!$B2,""))

 これを　F2 までフィルコピー

 G2 : =IF(元データ!$A2="","",元データ!C2)

 これを H2 にフィルコピー

 B2:H2 を下にフィルコピー

（β） 2017/05/21(日) 09:09

手順を整理すると、どんなマクロが必要かみえてきます。
それを組み合わせて完成させます

例えば、わたしがイメージした手順だと
こんなマクロがあれば、その組み合わせでできそうです。

１）A列の最大値を求めるマクロ
２）A列でデータのある最終行を求めるマクロ
３）データを転記するマクロ
４）同じ処理を繰り返すマクロ

レパートリーが増えてくると
組み合わせを変えて色々できるようになります。
こういうのは慣れです。
たくさん自分でやってみるのが一番です。

（マナ） 2017/05/21(日) 09:40

マナ様、β様

そうですね。
下記のように出来ました。
改良点等ありましたら教えてください。

Sub 内訳書作成()

    Dim gyo
    Dim flg
    Dim shin
    Dim shout
    Set shin = Worksheets("ひな型入力シート")
    Set shout = Worksheets("ひな型出力シート")

    gyo = 3
    For gyo = 3 To shin.Range("A65536").End(xlUp).Row
        If shin.Cells(gyo, 1) = 1 Then
            shout.Cells(gyo, 2) = shin.Cells(gyo, 2)
            ElseIf shin.Cells(gyo, 1) = 2 Then
                shout.Cells(gyo, 3) = shin.Cells(gyo, 2)
            ElseIf shin.Cells(gyo, 1) = 3 Then
                shout.Cells(gyo, 4) = shin.Cells(gyo, 2)
            ElseIf shin.Cells(gyo, 1) = 4 Then
                shout.Cells(gyo, 5) = shin.Cells(gyo, 2)
            ElseIf shin.Cells(gyo, 1) = 5 Then
                shout.Cells(gyo, 6) = shin.Cells(gyo, 2)
        End If
        shout.Cells(gyo, 7) = shin.Cells(gyo, 3)
        shout.Cells(gyo, 8) = shin.Cells(gyo, 4)
        shout.Cells(gyo, 9) = shin.Cells(gyo, 5)
    Next
End Sub
（ふみか） 2017/05/21(日) 09:44

１）最初に転記先のデータを消去するコードがあるとよいかも。

２）型も宣言する。例えば、

 ＞Dim gyo

 　Dim gyo As Long

３）A65536は、65536の意味はわかりますか。
Excel2013では意味ないです。

わたしなら、コメント付きで
データが1000件なら、A5000などとします。

あるいは、
Range("A" & Rows.count)
または、
Cells(Rows.count, 1)

とすることが多いようです。
（わたしも掲示板での回答ではそうしています）

４）転記先の列は、B列の値＋１で計算できます。
それを利用すると、もっと簡潔にかけると思います。

（マナ） 2017/05/21(日) 10:19

マナ様

ありがとうございます。

Sub 内訳書作成()

    Dim gyo
    Dim flg
    Dim shin
    Dim shout
    Set shin = Worksheets("ひな型入力シート")
    Set shout = Worksheets("ひな型出力シート")

    gyo = 4
        For gyo = 4 To shin.Range("A5000")
            flg = Cells(gyo, 1)
            shout.Cells(gyo, flg + 1) = shin.Cells(gyo, 2)
            shout.Range(Cells(gyo, 7), Cells(gyo, 9)).value = shin.Range(Cells(gyo, 3), Cells(gyo, 5)).value
        Next
End Sub

と、したのですがセルの範囲指定のところでエラーがでてしまいます。

また、
あるいは、
Range("A" & Rows.count)
または、
Cells(Rows.count, 1)
の書き方をするとエラーになります。
（ふみか） 2017/05/21(日) 11:01

 横から失礼。

 マナさんの指摘は

 >For gyo = 3 To shin.Range("A65536").End(xlUp).Row

 ここで、 A65536 というのは xl2007以降は意味がないので、それなら A5000 といったものを使ってはいかが？
 ということです。

 ですから

 For gyo = 3 To shin.Range("A5000").End(xlUp).Row

 とか

 For gyo = 3 To shin.Range("A" & Rows.Count).End(xlUp).Row

 としましょうね　ということですよ。

 基本的なコード組み立ては、マナさんのアドバイスの方向で頑張ってみてください。

 今回のレイアウトなら「たまたま」CurrentRegion で、元領域の参照が可能ですので
 それを使い、かつ、セルへの直接転記ではなく、いったん配列に納めて最後に一括転記　という
 以下のような構成も可能です。

 将来の参考として、アップしておきます。

 Sub Sample()
    Dim shin As Worksheet
    Dim shout As Worksheet
    Dim v As Variant
    Dim c As Range
    Dim x As Long

    Set shin = Worksheets("ひな型入力シート")
    Set shout = Worksheets("ひな型出力シート")

    With shin.Range("A1").CurrentRegion.Columns(1)
        With .Offset(1).Resize(.Rows.Count - 1)
            ReDim v(1 To .Rows.Count, 1 To 7)
            For Each c In .Cells
                Select Case c.Value
                    Case 1 To 7
                        x = x + 1
                        v(x, c.Value) = c.Offset(, 1).Value
                        v(x, 6) = c.Offset(, 2).Value
                        v(x, 7) = c.Offset(, 3).Value
                End Select
            Next
        End With
    End With

    With shout
        .Range("A1", .UsedRange).Offset(1).ClearContents
        .Range("B2").Resize(UBound(v, 1), UBound(v, 2)).Value = v
        .Select
    End With

 End Sub

（ β） 2017/05/21(日) 11:07

１）すべてのRange とか　Cellsについてシートを指定すること

 こんな感じです
 shout.Range(shout.Cells(gyo, 7), shout.Cells(gyo, 9)).Value = shin.Range(shin.Cells(gyo, 3), shin.Cells(gyo, 5)).Value

ただ

２）Resizeプロパティを覚えると、少しだけコンパクトに書けます

 shout.Cells(gyo, 7).Resize(,3).Value = shin.Cells(gyo, 3).Resize(,3).Value

３）初心者は、.Valueを省略しない習慣をつけたほうがよいです。

 For gyo = 4 To shin.Cells(Rows.Count, 1).End(xlUp).Row
    flg = Cells(gyo, 1).Value
    shout.Cells(gyo, flg + 1).Value = shin.Cells(gyo, 2).Value
    shout.Cells(gyo, 7).Resize(, 3).Value = shin.shin.Cells(gyo, 3).Resize(, 3).Value
 Next

（マナ） 2017/05/21(日) 11:50

コメント返信：

[ 一覧(最新更新順) ]

[[20170521072132]] 『判定番号により転記列を変えたい』（ふみか） ページの最後に飛ぶ

[[20170521072132]]　『判定番号により転記列を変えたい』（ふみか）　ページの最後に飛ぶ