プロが教えるわが家の防犯対策術!

派遣切り後、事務職の就職がようやく見つかりました。
仕事の効率を少しでも上げて、より多くの業務処理をしたいので下記のマクロを作成したいと考えています。
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

A 回答 (1件)

一例です。



だぶっている場合は、最後のデータを記入した上で緑にします。

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
    • good
    • 0
この回答へのお礼

100%私が欲しいマクロでした!
こんなに速く完璧な返信を頂いて感動して涙が出ました。
本当にありがとうございました。

お礼日時:2010/04/02 23:28

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