エクセルで自動計算結果を抽出させたいのですが・・・

質問

A列に1,000品の商品名、１行目に商品に対する項目がB列～N列にあったとして、それぞれの商品に対する項目には、すべて値があるとは限りません。

それで・・・ご質問ですが・・・

　G列の値よりH列の値（ここはすべて値があります）が大きい商品の行すべてを
　sheet２へコピーさせたいのですが、そのＶＢＡのコーディングをどなたか教
　えてください。

商品名　規格　価格　販売数（１）販売数（２）　・・・・・・
○○○　　　　　　　　　　ココ　　と　ココ　を比較して条件に該当したらこの行をsheet2へコピー
○○○　　　　　　　　　　　　　　※条件は、販売数（１）＜　販売数（２）
○○○
　　・
　　・
　　・

ＶＢＡについては、最近勉強し始めたばかりで初心者です。まだ、どういう風に目的にあわせたコーディングすればよい分かりません。が、困ったことに上記のような処理で、3,500品目を5つのパターンで明日までに処理までにしてくれ！と上司より言われ困っています。丸投げでお願いして申し訳ございませんが、よろしくお願いします。

回答No.5

nishi6 · ベストアンサー

一応作ってみました。
他のパターンがあるみたいですが、コードの「***」あたりを修正すれば応用できると思います。
これくらい品目が多くなるとExcelを使っていることの是非を検討する必要があると思いますが・・・。Accessとかデータベースは知ってしまえば簡単ですよ。

'条件に合致したらSheet1→Sheet2に書き出し
Public Sub Cyusyutu()
Dim wk1, wk2 As Worksheet 'Sheet1,2
Dim rg1, rg2 As Range 'Sheet1,2のセルA1
Dim maxRow As Long 'データ行数
Set wk1 = Worksheets("Sheet1"): Set rg1 = wk1.Range("A1")
maxRow = wk1.UsedRange.Rows.Count
Set wk2 = Worksheets("Sheet2"): Set rg2 = wk2.Range("A1")
Dim rw1, rw2 As Long 'Sheet1の行カウンタ
Dim cl As Long '列カウンタ
'*** 抽出 ***
wk2.Cells.Clear 'Sheet2をクリア
With rg1
'表題をコピー
For cl = 0 To 13
rg2.Offset(0, cl) = .Offset(0, cl)
Next
'データを抽出
For rw1 = 1 To maxRow
If .Offset(rw1, 6) < .Offset(rw1, 7) Then '*** 抽出条件 ***
rw2 = rw2 + 1
For cl = 0 To 13 '*** 指定すれば部分項目を抽出 ***
rg2.Offset(rw2, cl) = .Offset(rw1, cl) '書き出し
Next
End If
Next
End With
End Sub

お礼

nishi6さんありがとうございます。nishi６さんの回答はよく参考にさせてもらってます。とりあえずyuziroさんの補足にも書いていたんですが、ＶＢＥにコーディングしたらウィルスになってしまい。取り急ぎ、ＶＢＡを使わずにかたづけてしまいました。やっと終わって先ほど帰ってきました。やっぱりＶＢＡはもう少し勉強してからが良さそうですね。
今、本で勉強しているところです。まだ具体的なコーディングのところまでいってないのですが、すこしづつ仕組みが分かってきたとこです。
もっと勉強して、今度こんな無理難題な事を上司から言われても、軽くこなして見せ付けたいです。
とりあえず今日は、疲れたんで寝ます。おやすみなさい。

あっ！もちろん、作っていただいたプログラムは無駄にはしません！！早速、来週から暇になるんで、試してみます。これも勉強ですよね！
それでは、また何かあったら宜しくお願いします。ありがとうございました。

あっっ！！　もうひとつ！　Accessとかデータベース？？？？？
気になるアドバイスですねーっ！　Accessってこんなことも出来るんですか？ちょっとこの辺も勉強してみまーすっ　それとデータベースとは？？？？？

それでは、今度こそおやすみなさい。ZZZ。。。

回答No.4

yuziro

丸投げ質問に答えるのもどうか？
という向きもありますし、
この上司もどうか？
とも思いますが、一応回答を・・・・

比較的、理解しやすく記述してありますので、
今後のＶＢＡ学習の参考にしてください。

Sub Macro1()
Dim I As Integer, J As Integer, 商品数 As Integer

商品数 = 1000

Sheets("Sheet2").Activate
Sheets("Sheet2").Cells.ClearContents
Sheets("Sheet1").Rows(1).Copy
Sheets("Sheet2").Rows(1).Select
ActiveSheet.Paste

J = 0
For I = 1 To 商品数
If Sheets("Sheet1").Cells(I + 1, 7) < Sheets("Sheet1").Cells(I + 1, 8) Then
J = J + 1
Sheets("Sheet1").Rows(I + 1).Copy
Sheets("Sheet2").Rows(J + 1).Select
ActiveSheet.Paste
End If
Next I
End Sub

補足

yuziroさんありがとうございました。実は、このプログラムをコーディングして保存したら、ウィルスが発見されました。となってしまい一瞬焦りました。
結局アンチウィルスソフトで削除して事なきことを終えたのですが・・・
とりあえず怖くなったんで、今回はＶＢＡはやめました。自分でウィルスを作ってしまったようですね！というより壊れたプログラムをつっくたのでしょうけど・・・
はぁ！ＶＢＡってむずかしいですね！でもやっぱり、めんどくさがりの私にとっては、習得したいものです。これにめげずにこれからも勉強します。
また、なにかありましたら宜しくお願いします。

ところで・・・その後の処理として、ウィルスになってしまったファイルを削除してウィルスチェックもして「検出されませんでした」ってでたんですが、これで大丈夫ですよね？

回答No.3

134

関数でもできそうに思います。

例えば、g2＜h2で、シート１のa2にある商品名を、シート２のa2に表示させるとき、このセルに下式を入力。

=if(sheet1!$g2<sheet1!$h2,sheet1!a2,"")

ここで、g2≧h2のとき、何も表示されない状態になります。

このあと、オートフィルターで商品名(a列）を「空白以外」に設定することで、ｈ列がｇ列より大きいものの一覧表ができると思います。

　カーソルを右下にあわせ、ドラッグすることで、コピー可能なはずです。

ま、参考程度に…

お礼

１３４さんありがとうございます。あんまり難しく考えないほうが早かったみたいでした。

回答No.2

pappa

再びです。
右上のボックスは「より大きい」ではなく、「以上」でした。失礼しました。
（危うく会社を首にするとこでした・・・？）

回答No.1

pappa

それほど複雑な処理ではないので、VBAでなくてもいいのでは？
G列とH列の比較と言うことで、ここではI列に空白の列を挿入しましょう。
で、I列2行には（=H2-G2)として、それをすべてI列にコピーします。
次に、１行目を選択して（どの列でもOK）「データ」の「フィルタ」の「オートフィルタ」を選択します。
すると１行目にプルダウンのメニューが出てきます。
目的のI列のメニューを見て、「オプション」を選びます。
出てきたところの、左上のボックスに「1」、右上は「より大きい」を選び、OKボタン。
すると、この条件を満たすものだけが抽出されているはずです。
後は全部選択してコピーして、Sheet2にペースト。
手作業ですが応用が利くはず。
悩んでないで、すぐ始めないと間に合わないよっ！

お礼

pappaさんありがとうございます。とりえずいろいろ考えず、この方法でさっさと片付けました。VBAはもう少し勉強してからにします。
ほんとに悩んでたら終わらないとこでした。とりあえず無事に終わりました。
いっぱい残業つけてきた！あはは・・

どうもありがとうございました。