Excel VBA 列の値を調べてフラグ立て

質問

図のようなリストのB列に商品番号が入っています。
ただし
・シリアル（番号）はB列に入っている（固定）
・データの最終行は未定（表による）
・データのある右端の列も未定（表による）

このようなシートに対して、次のような操作ができるVBAのコードを教えてください。

1. データが入っている列の右端を調べ、そのさらに右列を入力列とする
（ここではF、罫線など書式設定は不要）
2. B列（シリアル）のデータの左から3文字を検査し、ABCとなっている行は◯を入力する
3. B列の頭3文字のうち、XXの2文字がある場合（XXZでもAZZも＝緑）、Aを入力する
4. B列の頭4文字以右に該当文字（ABCやXX）があっても該当しない（ピンクは対象外）。
5. 最終行の検証が終わったら終了（ここでは12行目が最終行）

お時間のあるときでいいので、よろしくお願いします。
Excel 2010 or 2013

回答No.2

kkkkkm · ベストアンサー

以下でいかがでしょう。

Sub Example()
Dim MyLastRow As Long, MyLastColumn As Long
Dim i As Long

MyLastColumn = Cells(3, Columns.Count).End(xlToLeft).Column
'3行目の備考以降右にデータのあるセルがある場合Columns.Countをデータのあるセルの左のセルを指定
'たとえばK3にデータがある場合　Cells(3, "J").End(xlToLeft).Column
MyLastRow = Cells(Rows.Count, "B").End(xlUp).Row
'B列の必要なデータがある行以降にデータがある場合Rows.Countを列の場合と同じように適宜変更してください。

For i = 4 To MyLastRow
If Left(Cells(i, "B").Value, 3) Like "ABC" Then
Cells(i, MyLastColumn + 1).Value = "○"
ElseIf Left(Cells(i, "B").Value, 3) Like "*XX*" Then
Cells(i, MyLastColumn + 1).Value = "A"
End If
Next

End Sub

お礼

ありがとうございました。

補足

動作しました。
1点確認をさせてください。

|MyLastColumn = Cells(3, Columns.Count).End(xlToLeft).Column
|'3行目の備考以降右にデータのあるセルがある場合Columns.Count
|をデータのあるセルの左のセルを指定
|'たとえばK3にデータがある場合　Cells(3, "J").End(xlToLeft).Column

とあるところの「'たとえばK3にデータがある場合　Cells(3, "J").End(xlToLeft).Column」の説明が理解できませんでした。

Columns.Countで列の最大（最終列）を指定し、
そこから
End(xlToLeft).Column
でデータのある最終列を探していると思います。そのためK3[備考]をそのまま認識していると思われます。

K3に[備考]とその列があった場合、"J"は何を意味されていらっしゃるのでしょうか。
時間のあるとき、ご教授お願いいたします。

回答No.5

kagakusuki

回答No.1、4です。
　他にも次の様な方法もあります。

Sub QNo9221617_Excel_VBA_列の値を調べてフラグ立て_別法()

Const FirstColumn = "A" '表の中で一番左端の列の列番号
Const SearchColumn = "B" 'シリアル（番号）が入力されているの列の列番号

Dim InputColumn As Long, SearchString(1) As String, OutputString(1) As String _
, LastRow As Long, c As Range

SearchString(0) = "ABC" '検索する文字列その1
SearchString(1) = "XX" '検索するの文字列その2
OutputString(0) = "◯" '検索するの文字列その1が見つかった場合に出力する値
OutputString(1) = "A" '検索するの文字列その2が見つかった場合に出力する値

InputColumn = Cells(ItemRow, Columns.Count).End(xlToLeft).column + 1
LastRow = Range(SearchColumn & Rows.Count).End(xlUp).row
If InputColumn <= Columns(FirstColumn).column + 1 Or LastRow <= ItemRow Then
MsgBox "処理すべきデータが見当たりませんません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "データ無し"
Exit Sub
End If

With Application
.ScreenUpdating = False
.Calculation = xlManual
End With

For Each c In Range(SearchColumn & ItemRow + 1 & ":" & SearchColumn & LastRow)
If c.Value Like SearchString(0) & "*" Then Cells(c.row, InputColumn).Value = OutputString(0)
If c.Value Like SearchString(1) & "*" Or c.Value Like "?" & SearchString(1) & "*" Then _
Cells(c.row, InputColumn).Value = OutputString(1)
Next c

With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With

End Sub

お礼

SearchStringは初めてみたので、覚えておこうと思います。
ありがとうございました。

回答No.4

kagakusuki

回答No.1です。

>変数未定義エラーが出たのですが

　失礼致しました。試作したVBAの構文の中から結局使わないで済んだ不要な変数を削除してまとめて行く段階で、誤ってLastRowの宣言まで消してしまっておりました。
　一応動作チェックはしていたのですが、当方が使用しているExcel2010では変数が未定義でも動作することはするので気づきませんでした。

>LastRowをLongで宣言したところ動作しました。

との事ですので、自力で修正してしまわれたため質問者様にはもう不要の事かも知れませんが、一応念のために修正版を投稿しておきます。

Sub QNo9221617_Excel_VBA_列の値を調べてフラグ立て()

Const FirstColumn = "A" '表の中で一番左端の列の列番号
Const SearchColumn = "B" 'シリアル（番号）が入力されているの列の列番号
Const ItemRow = 3 '表中で項目名が入力されている行の行番号
Const myLength = 3 'シリアルの中で検索対象とする頭文字の長さ

Dim InputColumn As Long, SearchString(1) As String, OutputString(1) As String _
, LastRow As Long, buf As Variant, temp As Variant, i As Long, j As Long

SearchString(0) = "ABC" '検索する文字列その1
SearchString(1) = "XX" '検索するの文字列その2
OutputString(0) = "◯" '検索するの文字列その1が見つかった場合に出力する値
OutputString(1) = "A" '検索するの文字列その2が見つかった場合に出力する値

InputColumn = Cells(ItemRow, Columns.Count).End(xlToLeft).column + 1
LastRow = Range(SearchColumn & Rows.Count).End(xlUp).row
If InputColumn <= Columns(FirstColumn).column + 1 Or LastRow <= ItemRow Then
MsgBox "処理すべきデータが見当たりませんません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "データ無し"
Exit Sub
End If

With Application
.ScreenUpdating = False
.Calculation = xlManual
End With

For i = ItemRow + 1 To LastRow
buf = Left(Range(SearchColumn & i).Value, myLength)
If buf <> "" Then
For j = 0 To 1
temp = InStr(buf & "", SearchString(j))
If temp > 0 Then Cells(i, InputColumn).Value = OutputString(j)
Next j
End If
Next i

With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With

End Sub

お礼

再度ありがとうございます。
2007以降そんなに問題が起こらないような気もしていましたが、コードのほかツールバーやリボンあたりの呼び出しが変わっているので、2010も含めてバージョン現物で1つ1つ確認すべきでした。

回答No.3

kkkkkm

> とあるところの「'たとえばK3にデータがある場合　Cells(3, "J").End(xlToLeft).Column」の説明が理解できませんでした。

画像の表ではE3が備考で最終右列ですが、それより右(たとえばK3)になにかしらのデータ(備考列ではなく)があった場合、Columns.Count列から探すとK列が最終右列となり実際の備考列と合致しないので、Columns.Count列からではなくJ列から左に向かって現在の表の再右列(備考列)を探してくださいということで、今の表の備考列がK3にあればということではなく、説明が不十分で失礼しました。

お礼

了解しました。
問題なく動作しています。考え方はこのやり方がよさそうです。ありがとうございました。

回答No.1

kagakusuki

以下の様なVBAでは如何でしょうか。

Sub QNo9221617_Excel_VBA_列の値を調べてフラグ立て()

Const FirstColumn = "A" '表の中で一番左端の列の列番号
Const SearchColumn = "B" 'シリアル（番号）が入力されているの列の列番号
Const ItemRow = 3 '表中で項目名が入力されている行の行番号
Const myLength = 3 'シリアルの中で検索対象とする頭文字の長さ

Dim InputColumn As Long, SearchString(1) As String, OutputString(1) As String _
, buf As Variant, temp As Variant, i As Long, j As Long

SearchString(0) = "ABC" '検索する文字列その1
SearchString(1) = "XX" '検索するの文字列その2
OutputString(0) = "◯" '検索するの文字列その1が見つかった場合に出力する値
OutputString(1) = "A" '検索するの文字列その2が見つかった場合に出力する値

InputColumn = Cells(ItemRow, Columns.Count).End(xlToLeft).column + 1
LastRow = Range(SearchColumn & Rows.Count).End(xlUp).row
If InputColumn <= Columns(FirstColumn).column + 1 Or LastRow <= ItemRow Then
MsgBox "処理すべきデータが見当たりませんません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "データ無し"
Exit Sub
End If

With Application
.ScreenUpdating = False
.Calculation = xlManual
End With

For i = ItemRow + 1 To LastRow
buf = Left(Range(SearchColumn & i).Value, myLength)
If buf <> "" Then
For j = 0 To 1
temp = InStr(buf & "", SearchString(j))
If temp > 0 Then Cells(i, InputColumn).Value = OutputString(j)
Next j
End If
Next i

With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With

End Sub

お礼

ありがとうございます。変数未定義エラーが出たのですが、LastRowをLongで宣言したところ動作しました。