エクセル関数で商品に区別符号をつける方法

質問

• エクセルの関数を使って商品のサイズと色にそれぞれ区別する記号番号を付ける方法を教えてください。
• 商品種類が3000以上、商品数は15000種類を超えるため、関数を使用して短時間で作業を行いたいです。
• サイズ名とカラー名を別々に番号付けして、同じ商品種類に対して記号番号を割り当てています。

回答No.2

tom04

こんばんは！
簡単なようで結構手間取りました。

VBAになってしまいますが一例です。
↓の画像のようにB列に表示させたいデータをG列に羅列しておきます。

Sheet2を作業用のSheetとして使用していますので、Sheet2は全く使用していない状態にしておいてください。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペーストし、Excel画面に戻ってマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, k As Long, endRow As Long, c As Range, r As Range, wS1 As Worksheet
Set wS1 = Worksheets("Sheet1")

Application.ScreenUpdating = False
With wS1
endRow = .Cells(Rows.Count, "A").End(xlUp).Row
If endRow > 1 Then
.Range("C2").Resize(endRow - 1).ClearContents
.Range("E2").Resize(endRow - 1).ClearContents
End If
For i = 2 To endRow
If .Cells(i, "A") <> .Cells(i - 1, "A") Then
.Cells(i, "C") = "a"
ElseIf .Cells(i, "B") <> .Cells(i - 1, "B") Then
Set c = .Range("G:G").Find(what:=.Cells(i - 1, "C"), LookIn:=xlValues, lookat:=xlWhole)
.Cells(i, "C") = c.Offset(1)
ElseIf .Cells(i, "B") = .Cells(i - 1, "B") Then
.Cells(i, "C") = Cells(i - 1, "C")
End If
Next i
End With

With Worksheets("Sheet2")
wS1.Range("A:A").AdvancedFilter Action:=xlFilterInPlace, unique:=True
wS1.Range("A:A").SpecialCells(xlCellTypeVisible).Copy .Range("A1")
wS1.ShowAllData

For k = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
wS1.Range("A1").AutoFilter field:=1, Criteria1:=.Cells(k, "A")
wS1.Range("D:D").SpecialCells(xlCellTypeVisible).Copy .Range("B1")
endRow = .Cells(Rows.Count, "B").End(xlUp).Row
If endRow < 3 Then
.Cells(2, "C") = 1
Else
.Cells(2, "C") = 1
For i = 3 To endRow
Set c = Range(.Cells(2, "B"), .Cells(i - 1, "B")).Find(what:=.Cells(i, "B"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Cells(i, "C") = c.Offset(, 1)
Else
.Cells(i, "C") = WorksheetFunction.Max(.Range("C:C")) + 1
End If
Next i
End If
Set r = wS1.Range("A:A").Find(what:=.Cells(k, "A"), LookIn:=xlValues, lookat:=xlWhole)
.Range(.Cells(2, "C"), .Cells(endRow, "C")).Copy
r.Offset(, 4).Select
Selection.PasteSpecial Paste:=xlPasteValues
.Range("C:C").ClearContents
Next k
.Cells.Clear
End With
wS1.AutoFilterMode = False
wS1.Range("A1").Select
Application.ScreenUpdating = True
MsgBox "処理完了"
End Sub 'この行まで

※　関数でないのでデータ変更があるたびにマクロを実行する必要があります。
※　G列が目障りであれば作業用SheetのSheet2にG列のデータを入力しておいても構いませんが、
コードが若干変わってきます。m(_ _)m

お礼

ありがとうございました。
マクロを使用できればと考えてはいたのですが、プログラムという観念があり敷居が高く踏み込めませんでした。
必要な状態を即利用可能な状態で実現できております。
利用環境はExcel 2003 SP3 です。

これを機に一歩ふみこんだエクセルの利用を意識したいと思っております。