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

それで・・・ご質問ですが・・・
 
 G列の値よりH列の値(ここはすべて値があります)が大きい商品の行すべてを
 sheet2へコピーさせたいのですが、そのVBAのコーディングをどなたか教
 えてください。

商品名 規格 価格 販売数(1)販売数(2) ・・・・・・
○○○          ココ  と ココ を比較して条件に該当したらこの行をsheet2へコピー
○○○              ※条件は、販売数(1)< 販売数(2)
○○○
  ・
  ・
  ・

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

このQ&Aに関連する最新のQ&A

VBA 学習」に関するQ&A: VBAの学習について

A 回答 (5件)

一応作ってみました。


他のパターンがあるみたいですが、コードの「***」あたりを修正すれば応用できると思います。
これくらい品目が多くなると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
    • good
    • 0
この回答へのお礼

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

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

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

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

お礼日時:2001/05/10 01:01

丸投げ質問に答えるのもどうか?


という向きもありますし、
この上司もどうか?
とも思いますが、一応回答を・・・・

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

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

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

補足日時:2001/05/10 00:41
    • good
    • 0

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



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

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

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

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

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

ま、参考程度に…
    • good
    • 0
この回答へのお礼

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

お礼日時:2001/05/10 00:32

再びです。


右上のボックスは「より大きい」ではなく、「以上」でした。失礼しました。
(危うく会社を首にするとこでした・・・?)
    • good
    • 0

それほど複雑な処理ではないので、VBAでなくてもいいのでは?


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

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

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

お礼日時:2001/05/10 00:29

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qエクセル プルダウンの作り方

お世話になります。
エクセルでプルダウンの作り方を教えていただけませんでしょうか?
住所を▼のボタンでクリックしたら【北海道,青森,秋田,岩手・・・】などの選択ができるようにしたいのです。
宜しくお願いします。

Aベストアンサー

メニューから「データ」、「入力規則」、「設定」で「入力値の種類」を「リスト」を選択します。
そうすると「元の値」という表示がでますので、そこで前もって作っておいたリストの範囲を指定します。
多くないのでしたら、そのままそこにカンマで区切って入力しても出来ます。

QExcel関数  A列の値とC列の値の間であればD列の値が抽出される関数

いつもお世話になっております。
F1にある数値を入れ、その数値が一覧表の中の範囲にマッチすればその数値を集計表シートのセルG1に反映したいのです。
例えば
A B C D E F G
1    1 ~ 1000  70 1200 ?
2  1001 ~ 1500  85
3  1501 ~ 2000  92
というような表があるとします。
F1に「1200」と入力するとG1には「85」と出るようにするにはG1にどのような関数を入れたらいいでしょうか。
必要があれば左の数値と~、右の数値は便宜上3列に分けて入力しています。
宜しくお願い致します。

Aベストアンサー

VLOOKUP関数でできます。

求める数値がD列にあるとします。
F1の値を $A$1:$D$3の範囲の左端の列から検索して、D列(検索範囲の4列目)の値を求めます。
セルG1に
=VLOOKUP(F1,$A$1:$D$3,4,TRUE)

一覧表を分かりやすくするために3列に分けているのだと思いますが、
値を求めるだけなら、B列、C列の「~1000」などは不要です。
B列、C列を削除して、「70,85,92・・・」をB列にしておけば
=VLOOKUP(F1,$A$1:$B$3,2,TRUE)
で求められます。

VLOOKUP関数をヘルプで参照していただくとわかると思いますが、
>TRUE を指定するか省略すると、検索値 が見つからない場合に、検索値 未満で最も大きい値が使用されます。
検索値が1200の場合、1200はA列にありませんが、1200未満でもっとも大きい値「1001」に対応する「85」が得られます。

Qエクセルでプルダウンメニューの作り方

  エクセルの画面で、よく三角形を逆さまにした形をクリックするといくつかメニューが出てき、どれかを選べるようになっていますが、その作り方を教えてください。
 会社で人事を担当していますが、三角形(プルダウンボタン)をクリックすると社員氏名一覧が表示され、そこから選択できるようにしたいのです。
 しばらく自力でいろいろやってみましたが、さっぱり見当がつかず、どうやればいいのか分かりませんでした。よろしくお願いします。

Aベストアンサー

こんばんは!
当方使用のExcel2003での一例です!

↓の画像のようにSheet2に名簿表を作成しておきます。
画像ではSheet2のA2セル以降を範囲指定 → 名前ボックスに仮に「名簿」と入力しOK
これで範囲指定したセルが「名簿」と名前定義されましたので、

Sheet1のリスト表示させたいセルを範囲指定 → メニュー → データ → 入力規則
→ リスト → 「元の値」の欄に
=名簿
としてOK

これでSheet1のセルをアクティブにすると右側に下向き▼が表示されますので、そこをクリック!
これで希望に近い形にならないでしょうか?
Excel2007の場合は↓のURLが参考になるかもしれません。

http://www.eurus.dti.ne.jp/~yoneyama/Excel2007/excel2007-ny_kis2.html

尚、同一Sheetに「名簿表」を作成する場合は名前定義する必要はなくて
「元の値」の右側の四角をクリックし、リスト表示したいセルをそのまま範囲指定すればOKです。

以上、お役に立てば良いのですが・・・m(_ _)m

こんばんは!
当方使用のExcel2003での一例です!

↓の画像のようにSheet2に名簿表を作成しておきます。
画像ではSheet2のA2セル以降を範囲指定 → 名前ボックスに仮に「名簿」と入力しOK
これで範囲指定したセルが「名簿」と名前定義されましたので、

Sheet1のリスト表示させたいセルを範囲指定 → メニュー → データ → 入力規則
→ リスト → 「元の値」の欄に
=名簿
としてOK

これでSheet1のセルをアクティブにすると右側に下向き▼が表示されますので、そこをクリック!
これで希望に近い形にならない...続きを読む

Qエクセルの関数です。一列目で指定した値の間で、二列目で指定した値を示す、一列目の最初の値を求める。

エクセルの関数です。
一列目で指定した値の間で、二列目で指定した値を示す、一列目の最初の値を求める関数を教えてください。
添付した図で、具体的に説明します。
A列に値(時間)、B列に値があります。
この配列の中から、
F4の値(時間)と同じ値(時間)を示すA列の行から、F5の値(時間)と同じ値(時間)を示すA列の行までの中で、
F3の値と同じ値がB列にある、A列の値(時間)の内、
A列で上から最初の値(時間)
です。

min、offset、index、match を組み合わせてみるのですが、うまくいきません。
どうぞよろしくお願いします。

Aベストアンサー

こんにちは!

画像の配置でF6セルに「7」という結果が返れば良い訳ですかね?

少し長くなりますが、
=INDEX(INDIRECT("A"&MATCH(F4,A:A,0)&":A"&MATCH(F5,A:A,0)),MATCH(F3,INDIRECT("B"&MATCH(F4,A:A,0)&":B"&MATCH(F5,A:A,0)),0))
という数式を入れてみてください。

※ F3セルは質問に載っていないので余計なお世話かもしれませんが
同じようなやり方で
=MAX(INDIRECT("B"&MATCH(F1,A:A,0)&":B"&MATCH(F2,A:A,0)))
という数式になると思います。

※ エラー処理はしていません。m(_ _)m

Qエクセル(Excel) 納品書の作り方【画像修正版

昨日http://oshiete.goo.ne.jp/qa/7348426.htmlで質問させていただき、詳しくご回答いただき少し進んだのですが、状況が変わったので改めて質問させていただきます。

■エクセル(Excel)で納品書の作成をしています。
シート1に納品書、シート2に商品マスタ(一覧)を作っていて、シート2の一覧を反映させて
納品書に番号を打ち込むだけで、商品名・単価までが出るシステムを作りたいのですが、
昨日のご回答の中の「VLOOKUP」?を入れて、自分なりにマス目の数字を変えてやってみたのですが
反映されずN/?のようなエラーになってしまいます。

※画像が見にくかったのでシート<CENTER></CENTER>だけにしました。

1、上記のように、シート2との関連付けの係数を、写真の場合の数字で教えてください。

2、合計と、合計から20%を引いた数値を割り出す関数も、写真の数字で御願いします。

宜しくご教授お願い致します。

Aベストアンサー

こんばんは!
前回投稿した者です。

当方もかなり古い(人間も古い!なぁ~んちゃって!)Excel2003を使用しています。
↓の画像のようにSheet2にデータを作成しておきます。

#N/A というエラーは、「検索値」がない!ということですので
お示しの画像のB列にSheet2のA列にないデータを入力するとそういったエラーが表示されます。

画像のセル配置ですと
C4セルに
=IF($B4="","",VLOOKUP($B4,Sheet2!$A:$C,COLUMN(B1),0))
(「$」マークの位置に気を付けてください)
という数式を入れD4セルまでオートフィルでコピー!
そのまま最後の24行目までコピーしておきます。

F4セルには
=IF(COUNTBLANK(B4:E4),"",D4*E4)
という数式を入れ、F24までオートフィルでコピー!

これでB列に商品番号を入力すればSheet2のデータが反映され、
E列に数量を入力でF列に金額が表示されると思います。

最後に合計金額のF26セルは
=IF(COUNT(F4:F24),SUM(F4:F24),"")
手数料のF27セルは
=IF(F26="","",F26*0.2)

これで何とか形にならないでしょうか?

※ 振込金額の欄は不明ですので手を付けていません。

参考になりますかね?m(_ _)m

こんばんは!
前回投稿した者です。

当方もかなり古い(人間も古い!なぁ~んちゃって!)Excel2003を使用しています。
↓の画像のようにSheet2にデータを作成しておきます。

#N/A というエラーは、「検索値」がない!ということですので
お示しの画像のB列にSheet2のA列にないデータを入力するとそういったエラーが表示されます。

画像のセル配置ですと
C4セルに
=IF($B4="","",VLOOKUP($B4,Sheet2!$A:$C,COLUMN(B1),0))
(「$」マークの位置に気を付けてください)
という数式を入れD4セルまでオートフィルで...続きを読む

Qsheet2の420列のデータを新たにsheetを7つ作成して60列ずつコピーするマクロ

sheet2にA1、B1~A420,B420までのデータ
例えば
A1:pinapple B1:パイナップル
A2:apple B2:リンゴ
A3:pen B3:ペン
・・・・・・・・
・・・・・・・・
・・・・・・・・
・・・・・・・・
A420:banana B420:バナナ
が入っています。

sheet3~sheet9(追加sheetは7つ)までを新たに作成して
①sheet3には、A1、B1~A60,B60
②sheet4には、A61、B61~A121,B120
③・・・・・・・・
④・・・・・・・・
⑤・・・・・・・・
⑥・・・・・・・・
⑦sheet9には、A361、B361~A420,B420
という具合に、sheet2のA1、B1~A420,B420のデータを60列ずつコピーさせてたいです。

どのようなマクロを作成すれば良いでしょうか?
実際は、データは単語ではなく文です。
Excel2013を使っています。

Aベストアンサー

こんにちは!

一例です。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, wS As Worksheet
With Worksheets("Sheet2")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row Step 60
If Worksheets.Count < i + 2 Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
End If
Set wS = Worksheets(Worksheets.Count)
.Cells(i, "A").Resize(60, 2).Copy wS.Range("A1")
wS.Columns.AutoFit
Next i
End With
End Sub

※ シート名には手を付けていません。m(_ _)m

こんにちは!

一例です。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, wS As Worksheet
With Worksheets("Sheet2")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row Step 60
If Worksheets.Count < i + 2 Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
End If
Set wS = Worksheets(Worksheets.Count)
.Cells(i, "A").Resize(60, 2).Copy wS.Range("A1")
...続きを読む

Qエクセル(Excel) 納品書の作り方【改めて】

昨日http://oshiete.goo.ne.jp/qa/7348426.htmlで質問させていただき、詳しくご回答いただき少し進んだのですが、状況が変わったので改めて質問させていただきます。

■エクセル(Excel)で納品書の作成をしています。
シート1に納品書、シート2に商品マスタ(一覧)を作っていて、シート2の一覧を反映させて
納品書に番号を打ち込むだけで、商品名・単価までが出るシステムを作りたいのですが、
昨日のご回答の中の「VLOOKUP」?を入れて、自分なりにマス目の数字を変えてやってみたのですが
反映されずN/?のようなエラーになってしまいます。

※画像が貼り付けてあります。商品名は1番以外伏せさせていただいています。
くっつけてありますが、左側がシート1・右側がシート2です。

1、上記のように、シート2との関連付けの係数を、写真の場合の数字で教えてください。

2、合計と、合計から20%を引いた数値を割り出す関数も、写真の数字で御願いします。

宜しくご教授お願い致します。

Aベストアンサー

画像がいまいちよく見えないのですが、納品書の項目は左から、No、商品番号、商品名、単価、数量、金額でいいのでしょうか(名前は多少違っていても意味があっていればもんだいないです)

でしたら、
C1セルに=IF(ISBLANK(B2),"",VLOOKUP(B2,Sheet2!$A$2:$C$200,2,FALSE))
D1セルに=IF(ISBLANK(B2),"",VLOOKUP(B2,Sheet2!$A$2:$C$200,3,FALSE))
E1セルは空白で
F1セルに=IF(D2="","",D2*E2)
といれて、C1からF1までをコピーしてその下の行にタテに貼り付ければ出来ますよ。
おそらくエラーが出たのは、コピーしたときにVLOOKUP関数の最初のセルの指定がずれてしまっているのでは無いかと思いますよ。     

Q【EXCEL】条件付き書式、A列、C列、D列、E列が同じ値の時にB列の背景色を変えたい

お世話になります。

エクセルの条件付き書式の数式の使い方について教えて下さい。
A列、C列、D列、E列の値が同じ時にB列のセルの背景を青に
塗りつぶしたいと思っています。

なので、「数式を使用して、書式設定するセルを決定」、
「次の数式を満たす場合に値を書式設定」で、数式を
「=A1=C1=D1=E1」と入力し、書式、塗りつぶし、青、
を選択して、条件付き書式を設定しました。
すると、、、画像のような結果になります。

私の感覚だと画像でセルの値が「11」~「15」の時だけ
B列が青になると思うのですが実際の結果は画像の通りです。

先の話の通りA列、C列、D列、E列の値が同じ時だけ
B列のセルの背景を青にしたい場合はどうい数式になるのでしょうか?

すいませんが、詳しい方、数式(関数?)で説明できる方よろしくお願い致します。

追記
可能でしたらA列、C列、D列、E列が空白の時はB列の背景色をなしにしたいと思っております。
→A列、C列、D列、E列に値があって、かつ同じ値の場合のみB列の背景を青にしたいです。

お世話になります。

エクセルの条件付き書式の数式の使い方について教えて下さい。
A列、C列、D列、E列の値が同じ時にB列のセルの背景を青に
塗りつぶしたいと思っています。

なので、「数式を使用して、書式設定するセルを決定」、
「次の数式を満たす場合に値を書式設定」で、数式を
「=A1=C1=D1=E1」と入力し、書式、塗りつぶし、青、
を選択して、条件付き書式を設定しました。
すると、、、画像のような結果になります。

私の感覚だと画像でセルの値が「11」~「15」の時だけ
B列が青にな...続きを読む

Aベストアンサー

AND関数を使えば判定ができるのでは?
 =AND(A2<>"",A2=C2,C2=D2,D2=E2)

A列には常に判定する数値が入っているなら「A2<>""」は不要です。

参考サイト
http://www.relief.jp/itnote/archives/003940.php

Qエクセル2007でプルダウンで選んだものに反応

Excel2007でプルダウンで選んだものに反応して隣のセルが自動入力される方法(エクセル2007)
A1をプルダウンで「猫」「犬」から選べるようにし、「猫」を選んだ場合B1に自動に「111」が、「犬」を選んだ場合B1に自動に「222」と入力されるようにしたいです。
ご教授の程、宜しくお願いします。

Aベストアンサー

VLOOKUP関数での方法です。
(1)別シートに入力文字列と対応コード表を作成。(仮にSheet2のA:B列範囲で順不同)
(2)B1に=IF(COUNTIF(Sheet2!A:A,A1),VLOOKUP(A1,Sheet2!A:B,2FALSE),"")を設定
   入力文字列が存在しない場合は空白としています。

Q(COUNTIFS ?)B列に任意の値があり、D列からF列の間にも任意の値がある場合に値を返す関数式

会社で修理業者に物品の修理を依頼する仕事をしているのですが、修理の際に出張費がかかる場合があり、余計な出費を避けるため、エクセルで素早くチェックできるようにしたいと思っております。

添付ファイルのとおり、任意の行のB列と同じ値が他の行のB列にあって(業者名が同じで)、かつ、その行の修理日・修理日2・修理日3のいずれかの値から前後6日以内の値が他の行において修理日・修理日2・修理日3にあった場合に、G列に「調整」という文字が入るようにしたいと思っております。

どのように関数式を組めばよいのか、どなたかご教授願います。

Aベストアンサー

VBA で良かったでしょうか?
ダメならスルーということで

処理範囲の行は A3 ~ A列データのある行とします
行の範囲を求めたら、B列 ~ F列を配列に読み込みます
(C列は非表示?)
修理業者をベースに Dictionary にデータを覚えていきます
Dictionary は3段構成
1段目キー:修理業者名
2段目キー:行番号
3段目キー:日付

Dictionary に展開できたら、
各修理業者の異なる行番号での日付差をグルグルチェックしていきます

※ B列 ~ F列を読み込んだ配列 vA は、
Dictionary に覚えたら不要になるので、
vA の1列目を結果書き出し用に再利用しています


Public Sub Samp1()
  Dim dic As Object
  Dim vA As Variant, vK As Variant
  Dim vRp As Variant, vRc As Variant
  Dim vDp As Variant, vDc As Variant
  Dim i As Long, j As Long
  Dim bSkip As Boolean
  Const CDAYW As Long = 6
  Const CMOJI As String = "調整"

  Set dic = CreateObject("Scripting.Dictionary")

  With Range("A3", Cells(Rows.Count, "A").End(xlUp))
    vA = .Columns("B:F").Value
    For i = 1 To UBound(vA)
      If (vA(i, 1) <> "") Then
        For j = 3 To UBound(vA, 2)
          If (vA(i, j) <> "") Then
            If (Not dic.Exists(vA(i, 1))) Then
              dic.Add vA(i, 1) _
                , CreateObject("Scripting.Dictionary")
            End If
            If (Not dic(vA(i, 1)).Exists(i)) Then
              dic(vA(i, 1)).Add i _
                , CreateObject("Scripting.Dictionary")
            End If
            dic(vA(i, 1))(i)(vA(i, j)) = Empty
          End If
        Next
        vA(i, 1) = ""
      End If
    Next

    For Each vK In dic.Keys
      For Each vRp In dic(vK).Keys
        If (vA(vRp, 1) = "") Then
          bSkip = False
          For Each vDp In dic(vK)(vRp).Keys
            For Each vRc In dic(vK).Keys
              If (vRp <> vRc) Then
                For Each vDc In dic(vK)(vRc).Keys
                  i = Abs(DateDiff("d", vDp, vDc))
                  If (i <= CDAYW) Then
                    vA(vRp, 1) = CMOJI
                    vA(vRc, 1) = CMOJI
                    bSkip = True
                    Exit For
                  End If
                Next
                If (bSkip) Then Exit For
              End If
            Next
            If (bSkip) Then Exit For
          Next
        End If
      Next
    Next
    .Columns("G").Value = vA
  End With

  Set dic = Nothing
End Sub

VBA で良かったでしょうか?
ダメならスルーということで

処理範囲の行は A3 ~ A列データのある行とします
行の範囲を求めたら、B列 ~ F列を配列に読み込みます
(C列は非表示?)
修理業者をベースに Dictionary にデータを覚えていきます
Dictionary は3段構成
1段目キー:修理業者名
2段目キー:行番号
3段目キー:日付

Dictionary に展開できたら、
各修理業者の異なる行番号での日付差をグルグルチェックしていきます

※ B列 ~ F列を読み込んだ配列 vA は、
Dictionary に覚えたら不要になるので、
...続きを読む


人気Q&Aランキング