※上sheet2
中sheet1
下sheet3
データは各シートB4から入っています。
sheet3の品番判定のマクロを組みたいのですがうまくいきません。
条件は、sh2にG~(同じコード)があるか。部品は同じか。⇒ コードがあり部品が同じならば”T”
コードはあるが、部品が違う。⇒ ”変更”
sh2にコードが無い。⇒ ”追加”
といった感じで表示させたいです。
例↓
G502___GG0002 ⇒ G501___GG0003 = 追加
G503___GG0003 ⇒ G502___GG0003 = 変更
G504___GG0001 ⇒ G503___GG0003 = T
私が組んだのだと途方も無く時間がかかり、しかも全部追加になってしまい悩んでます。
ご教授お願いいたします。
Sub change()
Dim CNT1, CNT2, CNT3, CNT4
Set sh3 = Sheet3
Set sh2 = Sheet2
Set sh1 = Sheet1
For CNT2 = 2 To 5
For CNT1 = 4 To 200
For CNT4 = 2 To 5
For CNT3 = 4 To 200
If sh2.Cells(CNT1, CNT2).Value <> "" Then
If sh2.Cells(CNT1, CNT2).Value <> sh1.Cells(CNT3, CNT4).Value Then
sh3.Cells(CNT1, CNT2 + 9).Value = "追加"
Else
If sh2.Cells(CNT1, 6).Value = sh1.Cells(CNT3, 6).Value Then
sh3.Cells(CNT1, CNT2 + 9).Value = "T"
Else
sh3.Cells(CNT1, CNT2 + 9).Value = "変更"
End If
End If
Else
sh3.Cells(CNT1, CNT2 + 9).Value = ""
End If
Next CNT3
Next CNT4
Next CNT1
Next CNT2
End Sub
No.5ベストアンサー
- 回答日時:
以下のようになります。
前のは破棄してください。---------------
Option Explicit
Public Sub 品番判定()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim dicT As Object '連想配列(キー:品名)(値:品番)
Dim row As Long
Dim col As Long
Dim key As String
Dim hantei As String '判定
Dim hinban As String '変更前品番
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
Set sh3 = Worksheets("sheet3")
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
'sheet1の品名のリストを作成する
For row = 4 To 200
For col = 2 To 5
'品名が空白でないなら、品番を記憶する
key = sh1.Cells(row, col).Value
If key <> "" Then
dicT(key) = sh1.Cells(row, 6).Value
End If
Next
Next
'sheet2の品名がsheet1にあるか検索する
For row = 4 To 200
For col = 2 To 5
hinban = "" '変更前品番クリア
'品名が空白でないなら、Sheet1にあるか判定する
key = sh2.Cells(row, col).Value
If key <> "" Then
'Sheet1にあれば、品番は一致か判定する
If dicT.exists(key) = True Then
If sh2.Cells(row, 6).Value = dicT(key) Then
hantei = "T"
Else
hantei = "変更"
hinban = dicT(key)
End If
Else
hantei = "追加"
End If
Else
hantei = "" '品名が空白なら判定は空白
End If
'判定結果をセット
sh3.Cells(row, col + 9).Value = hantei
'変更前品番をセット
sh3.Cells(row, col + 13).Value = hinban
Next
Next
MsgBox ("処理完了")
End Sub
--------------------
No.3
- 回答日時:
以下のようになります。
--------------------------------------
Public Sub 品番判定()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim dicT As Object '連想配列(キー:品名)(値:品番)
Dim row As Long
Dim col As Long
Dim key As String
Dim hantei As String
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
Set sh3 = Worksheets("sheet3")
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
'sheet1の品名のリストを作成する
For row = 4 To 200
For col = 2 To 5
'品名が空白でないなら、品番を記憶する
key = sh1.Cells(row, col).Value
If key <> "" Then
dicT(key) = sh1.Cells(row, 6).Value
End If
Next
Next
'sheet2の品名がsheet1にあるか検索する
For row = 4 To 200
For col = 2 To 5
'品名が空白でないなら、Sheet1にあるか判定する
key = sh2.Cells(row, col).Value
If key <> "" Then
'Sheet1にあれば、品番は一致か判定する
If dicT.exists(key) = True Then
If sh2.Cells(row, 6).Value = dicT(key) Then
hantei = "T"
Else
hantei = "変更"
End If
Else
hantei = "追加"
End If
Else
hantei = "" '品名が空白なら判定は空白
End If
'判定結果をセット
sh3.Cells(row, col + 9).Value = hantei
Next
Next
MsgBox ("処理完了")
End Sub
-----------------------------------------------------
スピードアップの為、連想配列を使用しています。
不明点があれば補足してください。
No.2
- 回答日時:
補足ありがとうございました。
以下の理解で良いでしょうか。
1)sheet2の品名がSheet1にあるかチェックする。
①sheet1になければ、”追加”とする。
②sheet1にあり、品番が一致すれば、”T"とする。
③sheet1にあり、品番が一致しなければ、”変更"とする。
2)上記の判定結果は、sheet3の品番判定の欄(K列~M列)に書き込む。
(判定欄(G列~J列)には書き込まない)
上記で間違いないでしょうか。
No.1
- 回答日時:
すみません。
状況がよくわかりません。まず、セルの位置ですが
Sheet2のG502はA2ですか?(上のシート)(とりあえずA2として以降の質問をします)
Sheet1のG501はA2ですか?(中のシート)(とりあえずA2として以降の質問をします)
Sheet3のG502はA2ですか?(中のシート)(とりあえずA2として以降の質問をします)
sheet3のA2のG502は、sheet2のどの列を検索ですか。
(sheet2のA2~Aの最後の行ですか、それともB、C、D列が空白でないなら、B,C,D列も検索するのですか)
部品は同じかという意味は、品番の比較ですか?
(sheet3のE2のGG0001とsheet2のE2のG0001は一致なのでT)
sheet3のB2は、sheet2のB2~Bの最後まで検索で良いですか?
結果を書き込む欄は、sheet3の判定欄で良いですか。(品番判定の欄には書き込まない)
sheet1は、検索しなくてよいですか。(sheet1を検索する旨がどこにも記述されていない)
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・14歳の自分に衝撃の事実を告げてください
- ・架空の映画のネタバレレビュー
- ・「お昼の放送」の思い出
- ・昨日見た夢を教えて下さい
- ・ちょっと先の未来クイズ第4問
- ・【大喜利】【投稿~10/21(月)】買ったばかりの自転車を分解してひと言
- ・メモのコツを教えてください!
- ・CDの保有枚数を教えてください
- ・ホテルを選ぶとき、これだけは譲れない条件TOP3は?
- ・家・車以外で、人生で一番奮発した買い物
- ・人生最悪の忘れ物
- ・【コナン30周年】嘘でしょ!?と思った○○周年を教えて【ハルヒ20周年】
- ・ハマっている「お菓子」を教えて!
- ・最近、いつ泣きましたか?
- ・夏が終わったと感じる瞬間って、どんな時?
- ・10秒目をつむったら…
- ・人生のプチ美学を教えてください!!
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・都道府県穴埋めゲーム
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセル:VBAで月変わりで、自...
-
excelの差込印刷で可視セルだけ...
-
エクセルVBA 別シートの複数の...
-
Excel VBA インデックスの境...
-
VBA:同じ文字列データの比...
-
Excel で行を指定回数だけコピ...
-
VBA別シートの最終行の下行へ貼...
-
エクセルVBAで 2種のリストを...
-
歯抜けの時間を埋めて行の挿入
-
エクセルVBAで SendKeys "{TAB}"
-
EXCELマクロで全シート対...
-
スマホ機種変更で旧機種のGoogl...
-
代替機にキズ
-
メールボックスがない時はどう...
-
スマホの画面が割れてしまいま...
-
故障した携帯をオークションで...
-
ちょっと教えてください。
-
FOMAカード(UIM)異常
-
不良セクタ
-
ipodとパソコン故障
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excelマクロで空白セルを詰めて...
-
Excel で行を指定回数だけコピ...
-
excelの差込印刷で可視セルだけ...
-
Excel VBA インデックスの境...
-
VBA別シートの最終行の下行へ貼...
-
エクセルVBAで SendKeys "{TAB}"
-
エクセルVBA 別シートの複数の...
-
エクセル:VBAで月変わりで、自...
-
エクセルVBAで 2種のリストを...
-
VBA:同じ文字列データの比...
-
歯抜けの時間を埋めて行の挿入
-
エクセル2007で、マクロで、結...
-
Excel VBAでシート内全体に非表...
-
EXCELマクロで全シート対...
-
VBA 貼付先範囲(行)がいっぱ...
-
VBAで複数シート選択
-
Excel VBA 時刻でのD...
-
VBAで条件が一致する行のデータ...
-
Excel VBA 複数条件にマッチし...
-
【VBA】UserForm1の中で使うワ...
おすすめ情報
>Sheet2のG502はA2ですか?
sheet1,2,3すべてB4です。
>sheet3のA2のG502は、sheet2のどの列を検索ですか?
括弧ないのとおりです。BCDにもデータが入ることがあります。(データ区切りを使用しているため)
>部品は同じかという意味は、品番の比較ですか?
品番が同じかという意味です。
>sheet3のB2は、sheet2のB2~Bの最後まで検索で良いですか?
200までの検索です。
>結果を書き込む欄は、sheet3の判定欄で良いですか。
sheet3でお願いします。
>sheet1は、検索しなくてよいですか。
sheet1とsheet2を比較しています。
sheet3にはsheet2の写し(G502等)が入っているので結果だけsheet3に表示させています。
お手数かけますがお願いします。
ひとつ忘れていました。
1)①、②、③おっしゃる通りです。
ただ、G~(以下コードします)と紐付けて品番の一致、不一致の判定にしたいと思ってます。
以前はカウントイフで表にあるかだけ判定していて変更もれをおこしたことがあり、その対処のために今回質問させていただいてます。
2)追加に関してはG列からJ列でコードが一致するかの判定を出していますので、品番判定はK列からM列に結果を表示させたいです。
度々申し訳ございません。よろしくお願いしたします。
連想配列...はじめてききました。
動かしてみて一つ思ったことがありまして、質問の追加をさせてほしいです。
O列からR列まで変更もとの品番を表示させようとしているのですが、そちらのほうも出来れば手を加えていただきたいです...
私は関数を入れてたんですが案の定ずれて表示されているので...
=IF($K$4="変更",元部品表!$F$4,"")
お時間よろしければご教授お願いします。