質問: 評価の事務処理をマクロでできないでしょうか 派遣切り後、事務職の就職がようやく見つかりました。 仕事の効率を少しでも上げて、より多くの業務処理をしたいので下記のマクロを作成したいと考えています。 1ヶ月前に書籍を購入して独自でできるか試したのですがダイレクトな情報が見つからず、基礎の部分だけはできたところです。 恐縮なのですがもし、できる方がいましたらぜひ教えて頂けませんでしょうか。 sheet1とsheet2があります。 sheet1は、a列には6桁の納品番号の羅列、b列は【空白】です。 sheet2は、顧客からの評価が記載→a,b,c,空白: a列には6桁の納品番号、b列は【評価】があります。 sheet1例 ●a列b列 238062 238075 238096 238220 92528 238230 238090 *a列はmax70行ほどあります ●sheet2例 a列b列 92528b 238062a 238075c 238090b 238096a 238220 ←空白(記載無し) 238230a *a列はmax500行ほどあります したいことは、 1.sheet1のa列にある6桁の納品番号を1つずつ検索 2.sheet2のa列ににその納品番号があるかどうか? 3.sheet2にその納品番号があれば、sheet2のその納品番号の右隣(sheet2のb列)の評価がa,b,c,空白 の何かを見ます 4.そして、sheet1のb列にその評価を記載します。空白の場合はsheet1のb列のセルを赤くします。 sheet2にはダブル数字がある可能性が有り、その場合はsheet1のb列のセルを緑色にします。 です。以下の「●sheet1処理後の例」を参照ください。 ●sheet1処理後の例 a列b列 238062a 238075c 238096a 238220セルを赤色にします 92528b 238230a 238090b
回答: 一例です。 だぶっている場合は、最後のデータを記入した上で緑にします。 sub test02() dim ws1 as worksheet dim ws2 as worksheet dim myrange1 as range dim myrange2 as range dim c1 as range dim c2 as range dim myct as long set ws1 = worksheets("sheet1") set ws2 = worksheets("sheet2") set myrange1 = ws1.range("a1", ws1.cells(rows.count, "a").end(xlup)) set myrange2 = ws2.range("a1", ws2.cells(rows.count, "a").end(xlup)) for each c1 in myrange1 myct = 0 for each c2 in myrange2 if c2.value = c1.value then if c2.offset(, 1).value = "" then c1.offset(, 1).interior.colorindex = 3 else c1.offset(, 1).value = c2.offset(, 1).value end if myct = myct + 1 end if next c2 if myct > 1 then c1.offset(, 1).interior.colorindex = 10 next c1 set ws1 = nothing set ws2 = nothing set myrange1 = nothing set myrange2 = nothing end sub