[[20170308162413]]　『空白の場合は転記しない』（まりも）　ページの最後に飛ぶ

『空白の場合は転記しない』（まりも）

同一ブック内にシート１、シート２があります。
シート２→１へ転記する繰り返し処理を書いているのですが、
シート２でデータが揃っていないものも全て転記処理されてしまうので
シート２で転記データが揃っていないときはシート１へ転記しない。
or転記後シート１で特定列に空白のセルがある場合その行を削除する
というコードをつけたしたいのですが、どのようにすれば良いでしょうか？

Sub sample()

   Dim i As Long
   For i = 3 To 6

    Worksheets("シート１").Cells(i, 2) = Worksheets("シート２").Cells(i, 1).Value
  　　　・
　　　　・（以下、転記作業）
　　　　・

  Next i

End Sub

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

 >まりも さん
 >シート２で転記データが揃っていないとき
 具体的に説明してください。
 シート２のデータがあるセル範囲を教えてください。
 セル範囲（開始行、最終行、開始列、最終列）
 どのようなとき、データが揃ってないとしているのですか？？？

 それと、転記先は、Sheet1のB3セルを起点として、下の行、
 右の列でいいですか？
 ****************************************************
 そんなわけはないと思いますが、ｺｰﾄﾞから読み取ると、
 開始行=3
 最終行=6
 開始列=1
 最終列=1
 ですが…、
 Sheet2で取り扱っているセル範囲は、A3,A4,A5,A6の4つだけですか？

（マリオ） 2017/03/08(水) 16:43

こういうことかなぁ。。。

Sub test()

    Worksheets("シート２").Range("A3:A6").SpecialCells(xlCellTypeConstants).Copy
    Worksheets("シート１").Range("B3").PasteSpecial Paste:=xlPasteValues
End Sub

Sub sample2()

    Dim i As Long
    Dim j As Long
    Dim v

    For i = 3 To 6
        v = Worksheets("シート２").Cells(i, 1).Value
        If Not IsEmpty(v) Then
            j = j + 1
            Worksheets("シート１").Range("B3").Cells(j, 1).Value = v
        End If
    Next
End Sub

（まっつわん） 2017/03/08(水) 16:59

マリオさん

どうもありがとうございます。実際のデータはボリュームが多いのでサンプルは簡略した範囲にしています。

シート１
　範囲→A3：N6

シート２
　範囲→A3：O6

シート２のA3：L6範囲にデータを貼り付け。M3:O6には数式が組んであり、貼り付けたデータを元に別の
データから数値を呼び出すように連動してあります。（M3:O6にはもともとデータが入っており空白がありません）そのためA3:L6で空白を含む場合は転記しないというのが理想です。ただ、歯抜けのデータもたまにあるので、G列を指定して、G列に空白がある＝転記しないということは可能でしょうか？（G列は必ず必要数値が入るので、G列が空白＝転記不要になります。他の列は転記必要だが一部空白になるパターン有）

もしくは、転記後、シート１で指定列に空白があった場合はそれを含む行を削除だと非常に助かります。

（まりも） 2017/03/08(水) 17:25

セル範囲が微妙に違う意味はなんでしょう？

＞G列に空白がある＝転記しないということは可能でしょうか？
形式を選択して貼付の空白を無視する
の機能ではだめですかね？

（まっつわん） 2017/03/08(水) 17:31

 >まりも さん

 >実際のデータはボリュームが多いので
 たいしたボリュームじゃないので、わかるように説明してください。

 【やりたいこと】
 判定を行うシート：Sheet2の「A3：L6」の12列

 第一処理：G列範囲に空白が、1つでもあれば、Sheet1への転記作業を中止して、
           第二作業は行わない。←可能です！
 第二処理：空白でないと判定されたセルの値のみをSheet1の「A3：N6」に貼り付ける。

 *************************************************************************
 ここで、第二処理について、質問します。

 貼り付け先のSheet1の「A3：N6」は、14列です。
 これに対し、貼り付け元のSheet2の「A3：L6」は、◆12列です。

 例えば、Sheet1のA3セルを基準に貼り付けるなら、
 Sheet1のM,N列にデータが貼り付くことはありません。
 Sheet1の★【どのセル】を基準にして、当該◆12列分のデータを貼り付けるのでしょうか？？

 ****************************************************
 >シート２のA3：L6範囲にデータを貼り付け。
 また、Sheet2の「A3：L6」範囲には、数式は入力されることはないと理解しています。

 *******************************************************
 >もしくは、転記後、シート１で指定列に空白があった場合はそれを含む行を削除だと非常に助かります。

 ★指定列とは、どの列？はじめから、決まってますか？
（それとも、何か判定してから、指定列を決めるんですか？）

（マリオ） 2017/03/08(水) 20:12

ボリュームは日々変動しますが200行もあればカバーできます。

なので、A3:L200が判定を行う範囲となります。

【やりたいこと】

 判定を行うシート：Sheet2の「A3：L200」

 第一処理：G列範囲に空白が、1つでもあれば、Sheet1への転記作業を中止して、
           第二作業は行わない。

 第二処理：空白でないと判定されたセルの値のみをSheet1の「A3：N200」に貼り付ける。

使用するのは、シート2のA3:O200になりますが、順序を入れ替えてシート1にコピーしています。
（すみません、肝心の情報をお伝え忘れていました）

基準となるのはシート1のBとなります（A列は行番号が入っている）

シート2のA3:L200には数式は入力されません。M3:O200範囲のN,O列に数式が組んであり、
A3:L200にデータを値貼り付けすると連動してN3:O200で計算結果が出ます（Mは行番号を入れてあるので
リスト範囲としては使用していますが、数式は入っておりません）

わかりづらくて申し訳ありませんがこんな感じにコピー＆ペーストしていく状況です↓

シート２　　ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＮＯ
　　　　　　↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
シート１　　ＢＨ×××ＦＫ×××ＧＮ×ＩＭＪ

（↑表記がずれてしまいますがシート2Ａ→シート1Ｂ、シート2Ｂ→シート1Ｈ…（以下略）という意味で書いています）

シート1の×部分は入力する値が決まっているので、別途VBAで追記する形にしています。

現在はシート２の対象範囲をコピーしてシート１に転記しているのですが、まるごとコピーして入れ替えているだけなので、シート１に転記後手動で不要な行を削除している状況です。（ex:転記対象が150行だったとして、MAX値の200行分を毎回コピペして転記して追記しているので×部分だけ200行分出る。手動で50行を削除して150行として補完）

この不要な行を削除する行為を無くしたいのですがループ処理が上手く考えれず、とりあえずMAX値の範囲をコピーして後から不要部分を目視で削っている状態なので改善出来ればと質問しました。もしかしたら初期の質問と実際のコードの組み立ての考え方がそもそも違うかもしれません…。

（まりも） 2017/03/16(木) 10:36

 >まりも さん

 まったく理解できません。
http://d.kuku.lu/
 ↑こちらに、処理前のシート（Sheet2）
 と処理後のシート（Sheet1）の★おおきな画像を
 アップロードして、この掲示板に
 ダウンロード用のURLを貼ってもらえますか？

 なんなら、画像じゃなくて、エクセルファイルでも
 いいです。エクセルファイルの場合は、プロパティより
 個人情報を削除して、zipファイル化したものを
 アップロードしてください。
 ------------------------------------------------
 >使用するのは、シート2のA3:O200になりますが、
 >順序を入れ替えてシート1にコピーしています。 
 「順序を入れ替えて」といわれましても、
 ★どんな法則で入れ替えているのかを説明して
 もらえますか？縦方向、横方向？

  -----------------------------------------------
 >シート２　　ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＮＯ
 >　　　　　　↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
 >シート１　　ＢＨ×××ＦＫ×××ＧＮ×ＩＭＪ

　シート２の「A列」→シート１の「B列」は、
　分かりますが、
　シート２の「B列」→シート１の「H列」は、
　なんで、その列になるのか、説明されて
　ないですよね？
　シート２の「B列」→シート１の「C列」
　でないのは、なぜなんですか？？？

　また、シート１のHの後に、×が３回続いた後に、
　Fがありますが、Hの後のFって？
　アルファベット順ではないですが…？
　シート１の転記先の法則は、なんですか？？？
　

 シート２は、Ａ列～Ｏ列ｎ１５行ですが、
 上記では、「NN」となっていて上段は16個の
 アルファベットがありますし…、
 中段の「↓」も16個ありますけど？単なる間違い？
 下段は、×も含め15個ありますね。1個足りません。

 シート１のＢ列が転記を始める列なのですね。
 （シート１のＡ列には、何も転記しない！）

 シート１の転記の対象となる列は、
 Ｂ列～Ｎ列とのことですが、
 B列～Ｎ列だと、１３列分しかありません。

 Sheet2が、16列なのに対して、
 Sheet1が、13列です。
 どういうことでしょうか？？？

（マリオ） 2017/03/18(土) 04:26

 おはようございます。

 フィルターオプションを使えば出来そうな要件ですね。

 以下の条件でコードを記述しています。
 両方のシートの2行目にそれぞれ項目名が入力されている。
 且つ、項目行は2行目のみ。
 両方のシートの項目名は同じデータは同じ名前になっている。
 シート2のQ1に、シート2のG列の項目名、Q2に<>　と予め抽出条件を入力している。

 Sub test()
    Dim rng1(2) As Range
    Dim rng2(1) As Range
    Dim k As Integer

    With Sheets("シート1")
        Set rng1(0) = .Range("B2")
        Set rng1(1) = .Range("F2:K2")
        Set rng1(2) = .Range("M2:N2")
    End With
    With Sheets("シート2")
        Set rng2(0) = .Range("A2:O200")
        Set rng2(1) = .Range("Q1:Q2")
    End With

    For k = 0 To 2
        rng2(0).AdvancedFilter xlFilterCopy, rng2(1), rng1(k), False
    Next k

 End Sub

（sy） 2017/03/18(土) 08:34

説明が下手で申し訳ありません。画像をアップさせていただきましたので一度ご確認頂けますでしょうか？

http://d.kuku.lu/4992a5ddc0

http://d.kuku.lu/58c967bf31

Sheet1とSheet2の画像となります。色分けしてみましたが伝わりますでしょうか？
法則は特にありません。システムから抽出できるデータの項目順と、外部に提出する際のデータ項目順が
異なる為、指定されている項目順に並べ替えて転記する必要があるのでこのような状況となっています。Sheet1のデータ項目順序は提出先からの指定となる為こちらでは順番はいじれません。

また、システムから抽出できるデータのみで提出データが完成しないため、Sheet2のN,O列でVlookup式を
入力して更に別のデータを引っ張ってきております。抽出データ＋Vlookupで引っ張ってきたデータを
合算したうち、必要分だけ抜粋してSheet1に転記が必要という説明で上手く伝わりますでしょうか…？

現状、SheetA3:A200をコピー→Sheet1B3:B200ペーストというように1列ずつ細大行をコピーして張り付けるコードを書いてあります。ただこれですと最大値を取るのでたとえ5行しか必要なかったとしても200行分を切り貼りするので後からSheet1の不要な部分を削除しなくてはなりません。(Sheet1のC,D,E,Lに別途VBAで項目を追記したりしているため削除しないと提出時に不要なデータまでついていってしまう）その作業を無くしたく、冒頭のような質問になりました。

syさんのコードはまた後ほど確認させていただきます。取り急ぎ画像をアップいたしました。
（まりも） 2017/03/21(火) 12:25

 タイトル行を工夫すれば効率の良いフィルター関連処理も使えそうですが、
 以下は、効率を全く無視し、愚直に、ループでセル毎転記。

 処理の先頭で、転記先領域のクリアをいれるのが好きなんですが、転記対象外の列もクリアしていいのかどうか
 不明でしたので、とりあえず、事前クリアはしていません。

 また、最大200行目までといった説明がありましたが、そこも、データが存在するだけ転記。
 必要であれば 200行転記すれば、処理終了　といった制御を追加してください。

 Sub Sample1()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim i As Long
    Dim x As Long

    Application.ScreenUpdating = False

    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")

    x = 3   '転記開始行

    For i = 3 To sh2.Range("G" & Rows.Count).End(xlUp).Row
        If sh2.Range("G" & i).Value <> "" Then  'G列セルが空白なら転記しない
            sh1.Range("B" & x).Value = sh2.Range("A" & i).Value
            sh1.Range("F" & x).Resize(, 6).Value = _
                Array(sh2.Range("F" & i).Value, sh2.Range("K" & i).Value, sh2.Range("B" & i).Value, _
                        sh2.Range("N" & i).Value, sh2.Range("O" & i).Value, sh2.Range("G" & i).Value)
            sh1.Range("M" & x).Resize(, 2).Value = Array(sh2.Range("N" & i).Value, sh2.Range("L" & i).Value)
            x = x + 1
        End If
    Next

 End Sub

（β） 2017/03/22(水) 08:56

 もしフィルターオプションでは抽出出来ないような項目名や結合セルなどになっているなら、
 オートフィルタで抽出してから、列を丸ごとコピペと言う方法もあります。

 Sub test2()
    Dim rng As Range
    Dim col1 As Variant
    Dim col2 As Variant
    Dim k As Integer

    col1 = Array(2, 8, 6, 11, 7, 14, 9, 13, 10)
    col2 = Array(1, 2, 6, 7, 11, 12, 14, 14, 15)
    With Sheets("シート2")
        Set rng = Intersect(.Range("A2:O" & Rows.Count), .Range("A2", .UsedRange))
    End With

    rng.AutoFilter Field:=7, Criteria1:="<>"
    For k = 0 To 8
        rng.Offset(1).Columns(col2(k)).SpecialCells(xlCellTypeVisible).Copy _
                Sheets("シート1").Cells(3, col1(k))
    Next k
    rng.AutoFilter

 End Sub

（sy） 2017/03/22(水) 22:12

コメント返信：

[ 一覧(最新更新順) ]

[[20170308162413]] 『空白の場合は転記しない』（まりも） ページの最後に飛ぶ

[[20170308162413]]　『空白の場合は転記しない』（まりも）　ページの最後に飛ぶ