言語化が出来ません…

Question

VBAについて質問があります。
初心者です。色々調べましたが、どうしたら言語化出来るか結局わからず、この場を借りてアドバイスをいただければと思い投稿させて頂きました。

実現したいこととしては、
指定したセルになんからの文字が入っていたら、別のsheetの同じ名前のついた行と列のセルに色を付ける。
というものです。

例えば、
sheet1のA列のA2から下に『りんご』『ばなな』『メロン』といった名前が入っているとします。
また、1行目にはB1から5/1、5/2と言うように、日付が入っているとします。

sheet2にはA列のA2から下に『ばなな』『りんご』『メロン』と名前が入っています。
※Sheet1と同じ順番で名前は入っていません。ランダムです。
また、1行目にはB1から5/1、5/2と入っていますが、Sheet1とは違い、日付同士が4列あいています。各日付に4列与えられているということになります。(5/1はB1、5/2はF1のセル)

これらを前提条件として、
Sheet1の『りんご』の行の5月2日に「A」といった何らかの文字が入った場合、Sheet2の『りんご』の行の5月2日の4列に色をつけたいということです。

説明下手ですみません。
VBA勉強中でまだまだ分からないことだらけです。
アドバイスを頂いてこれからもっと詳しくなっていきたいので、お力をお借り出来ればと思います。
よろしくお願いします！

Comments

[m.ts10806]

まず思った通りにコードを書いてみては？
言葉にできなくてもそれでやろうとしていることが伝わることもあります。（ないときもあるけど、何もしないよりマシ）

[meg_]

・文章だけでは分かりにくいので、シートのイメージ画像を掲載すると良いかと思います。
・VBA勉強中とのことですが、「Sheet1の『りんご』の行の5月2日に「A」といった何らかの文字が入っ」ているかどうか？ぐらいはVBAで書けますか？

Answer 1

【マクロの記録】を使う

先ずはマクロの記録を使って、Excel-VBAを自動作成されたら如何でしょうか。
リボンへ開発メニューを登録してマクロの記録をクリックすると開始されます。
(開発メニューはファイル・オプション・リボンで登録できる筈です。)

マクロの記録開始後に、検索/色付け/関数書き込み等行うと、VBAプログラムが
勝手に作成されます。

こちらを基に、修正を加えつつ動作させることで感じが掴めるかと思います。
VBAのコーディング画面からF8を押すと1行づつ実行されます。
その後に疑問点を絞って調べられれば宜しいかと思います。

p.s.
私見ですがプログラミングで最も重要な事は名前付けです。
内容に対して適切な名前を付ける必要があります。
今回のタイトル「言語化が出来ません…」も一種の名前付けになります。
後々の時間経過後に見た時に、その名前から内容を思い出せる様な名称を付けるのが良いです。

Answer 2

言語化が出来ません…

始まり

前提条件
　シート「Sheet1」の「A1」を含むアクティブな表がある
　シート「Sheet2」の「A1」を含む表は1項目が4列使っている

Sheet1の表のセル範囲の各行を順に見て行く
　　　　各行の2つ目のセルから最後まで、各セルを順に見ていく
　　　　　　もし、各セルの値が空白でないなら、その時は、
　　　　　　　　Sheet2の表の範囲について
　　　　　　　　行の位置の取得＝その1列目のどの行にあるかMatch関数で検索
　　　　　　　　列の位置の取得＝（各セルの列番号-2）×4+2
　　　　　　　　その表のうちのセル範囲（行の位置,列の位置）を塗潰す
　　　次のセル
次の行

終り

これをVBA語に翻訳すると、

Option Explicit

'始まり
Sub test()

'
'前提条件
'　シート「Sheet1」の「A1」を含むアクティブな表がある
Dim rngOld As Range: Set rngOld = Worksheets("Sheet1").Range("A1").CurrentRegion
'　シート「Sheet2」の「A1」を含む表は1項目が4列使っている
Dim rngNew As Range: Set rngNew = Worksheets("Sheet2").Range("A1").CurrentRegion
Const cmyNum As Long = 4
'
Dim r As Range
'Sheet1の表のセル範囲の各行を順に見て行く
For Each r In rngOld.Rows
'    各行の2つ目のセルから最後まで､各セルを順に見ていく
    Dim ix As Long
    Dim ixRow As Long
    Dim ixCol As Long
    Dim c As Range
    For ix = 2 To r.Columns.Count
'        もし､各セルの値が空白でないなら､その時は､
        Set c = r.Cells(ix)
        If c.Value <> Empty Then
'            Sheet2の表の範囲について
            With rngNew
'            行の位置の取得 = その1列目のどの行にあるかMatch関数で検索
                ixRow = WorksheetFunction.Match(c, .Columns(1), 0)
'　　　　　　列の位置の取得＝（各セルの列番号-2）×4+2
                ixCol = (ix - 2) * cCol + 2
'　　　　　　その表のうちのセル範囲（行の位置,列の位置）を4列分拡張して塗潰す
                .Cells(ixRow, ixCol).Resize(, cCol).Interior.Color = vbRed
            End With
        End If
'    次の番号
    Next
'次の行
Next
'
'終り
End Sub

とりあえず、こんな感じですかね？
コンパイルも動作確認もしてないです。
どこかに論理の飛躍や説明の抜けがあるかも知れませんが、
この辺を叩き台に、組み立ててデバッグしてみてください。
参考になれば。