アプリ版:「スタンプのみでお礼する」機能のリリースについて

エクセルのマクロVBAで質問です。
1つのシートに下記のような(1)(2)のデータと
同ブック内・別シートに(3)(4)のデータがあり
(1)のデータ内を検索して、
別シート内の置換リスト(3)に値が存在すれば、
(4)の値を(2)に記載し、なければ、(1)の値をそのまま(2)に記載
するという内容にしたいのですが、どうもうまくいきません。

(1)    (2)
AAAA ■■■←AAA
BBBB ■■■←JJJ
CCCC ■■■←CCC
DDDD ■■■←GGG
EEEE ■■■←UUU
FFFF ■■■←FFF

置換リスト(同ブック内・別シート)
(3)    (4)
BBBB JJJ
DDDD GGG
EEEE UUU

いい方法はないでしょうか。

A 回答 (1件)

ほい


標準モジュールに書けば動く

Option Explicit

Sub SHT_Check()
    Dim iCnt As Integer
    Dim iMax As Integer
    Dim jCnt As Integer
    Dim jMax As Integer
    Dim SHT1 As Worksheet
    Dim SHT2 As Worksheet

    Set SHT1 = Sheets("Sheet1") '以下Sheets("Sheet1")の代わりに使用
    Set SHT2 = Sheets("Sheet2") '以下Sheets("Sheet2")の代わりに使用

    iMax = SHT1.Range("A1").CurrentRegion.Rows.Count 'Sheets("Sheet1")の最大行数(ループ回数)
    jMax = SHT2.Range("A1").CurrentRegion.Rows.Count 'Sheets("Sheet2")の最大行数(ループ回数)

    For iCnt = 1 To iMax '1行目からデータが連続する間ループ
        For jCnt = 1 To jMax '1行目からデータが連続する間ループ
            If SHT1.Cells(iCnt, 1).Value = SHT2.Cells(jCnt, 1).Value Then 'もし値が一致してたら
                SHT1.Cells(iCnt, 2).Value = SHT2.Cells(jCnt, 2).Value '変換
                Exit For '置き換えたら後続不要(次は当然一致しないから、再変換防止)
            Else '違ってたら
                SHT1.Cells(iCnt, 2).Value = SHT1.Cells(iCnt, 1).Value 'B列iCnt行に入力
            End If
        Next jCnt
    Next iCnt
End Sub


データが連続してない(空白セルがある)と失敗するかも
ああ、それとたぶんこのままじゃ実際には使えないだろうから、シート名はどこを置き換えるとか、cellsの括弧内が何を表してるかは、自力で調べてね
    • good
    • 0

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