[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『空白の場合は転記しない』(まりも)
同一ブック内にシート1、シート2があります。
シート2→1へ転記する繰り返し処理を書いているのですが、
シート2でデータが揃っていないものも全て転記処理されてしまうので
シート2で転記データが揃っていないときはシート1へ転記しない。
or転記後シート1で特定列に空白のセルがある場合その行を削除する
というコードをつけたしたいのですが、どのようにすれば良いでしょうか?
Sub sample()
Dim i As Long For i = 3 To 6
Worksheets("シート1").Cells(i, 2) = Worksheets("シート2").Cells(i, 1).Value ・ ・(以下、転記作業) ・
Next i
End Sub
< 使用 Excel:Excel2013、使用 OS:Windows7 >
>まりも さん >シート2で転記データが揃っていないとき 具体的に説明してください。 シート2のデータがあるセル範囲を教えてください。 セル範囲(開始行、最終行、開始列、最終列) どのようなとき、データが揃ってないとしているのですか???
それと、転記先は、Sheet1のB3セルを起点として、下の行、 右の列でいいですか? **************************************************** そんなわけはないと思いますが、コードから読み取ると、 開始行=3 最終行=6 開始列=1 最終列=1 ですが…、 Sheet2で取り扱っているセル範囲は、A3,A4,A5,A6の4つだけですか?
(マリオ) 2017/03/08(水) 16:43
Sub test()
Worksheets("シート2").Range("A3:A6").SpecialCells(xlCellTypeConstants).Copy Worksheets("シート1").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("シート2").Cells(i, 1).Value If Not IsEmpty(v) Then j = j + 1 Worksheets("シート1").Range("B3").Cells(j, 1).Value = v End If Next End Sub
(まっつわん) 2017/03/08(水) 16:59
どうもありがとうございます。実際のデータはボリュームが多いのでサンプルは簡略した範囲にしています。
シート1
範囲→A3:N6
シート2
範囲→A3:O6
シート2のA3:L6範囲にデータを貼り付け。M3:O6には数式が組んであり、貼り付けたデータを元に別の
データから数値を呼び出すように連動してあります。(M3:O6にはもともとデータが入っており空白がありません)そのためA3:L6で空白を含む場合は転記しないというのが理想です。ただ、歯抜けのデータもたまにあるので、G列を指定して、G列に空白がある=転記しないということは可能でしょうか?(G列は必ず必要数値が入るので、G列が空白=転記不要になります。他の列は転記必要だが一部空白になるパターン有)
もしくは、転記後、シート1で指定列に空白があった場合はそれを含む行を削除だと非常に助かります。
(まりも) 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列分のデータを貼り付けるのでしょうか??
**************************************************** >シート2のA3:L6範囲にデータを貼り付け。 また、Sheet2の「A3:L6」範囲には、数式は入力されることはないと理解しています。
******************************************************* >もしくは、転記後、シート1で指定列に空白があった場合はそれを含む行を削除だと非常に助かります。
★指定列とは、どの列?はじめから、決まってますか? (それとも、何か判定してから、指定列を決めるんですか?)
(マリオ) 2017/03/08(水) 20:12
なので、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 ABCDEFGHIJKLMNNO
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
シート1 BH×××FK×××GN×IMJ
(↑表記がずれてしまいますがシート2A→シート1B、シート2B→シート1H…(以下略)という意味で書いています)
シート1の×部分は入力する値が決まっているので、別途VBAで追記する形にしています。
現在はシート2の対象範囲をコピーしてシート1に転記しているのですが、まるごとコピーして入れ替えているだけなので、シート1に転記後手動で不要な行を削除している状況です。(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にコピーしています。 「順序を入れ替えて」といわれましても、 ★どんな法則で入れ替えているのかを説明して もらえますか?縦方向、横方向?
----------------------------------------------- >シート2 ABCDEFGHIJKLMNNO > ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ >シート1 BH×××FK×××GN×IMJ
シート2の「A列」→シート1の「B列」は、
分かりますが、
シート2の「B列」→シート1の「H列」は、
なんで、その列になるのか、説明されて
ないですよね?
シート2の「B列」→シート1の「C列」
でないのは、なぜなんですか???
また、シート1のHの後に、×が3回続いた後に、
Fがありますが、Hの後のFって?
アルファベット順ではないですが…?
シート1の転記先の法則は、なんですか???
シート2は、A列〜O列n15行ですが、 上記では、「NN」となっていて上段は16個の アルファベットがありますし…、 中段の「↓」も16個ありますけど?単なる間違い? 下段は、×も含め15個ありますね。1個足りません。
シート1のB列が転記を始める列なのですね。 (シート1のA列には、何も転記しない!)
シート1の転記の対象となる列は、 B列〜N列とのことですが、 B列〜N列だと、13列分しかありません。
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
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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.