【身内用】コード＆関数全文

■適用方法

①開発タブを表示させる

　Excelを開き、ファイル→オプション→リボンのユーザ設定→「開発」にチェックを入れOK

②シート作成

　以下の画像を参考に、「本体」「条件表」シートを作成する（シート名は変えないで下さい）

　※数式の内容

　本体シート

　　・K2：=IF(L2=1,"○","×")

　　・L2：=$B2&$C2&$D2&$E2&$F2

　　・M2：=条件表!$G2

　　・N2：=COUNTIF($J$2:$J$201,$I2)

　条件表シート

　　・H2：=$B2&$C2&$D2&$E2&$F2

③Alt+F8でマクロの洗濯画面を表示後、適当な名前を入力して作成をクリック。

表示された画面に以下のソースをコピペする。

～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～

Option Explicit
Sub 判定()

Dim i As Integer
i = 1

Do Until ActiveSheet.Cells(i, 6).Value = ""



i = i + 1

Loop

Range("K2").Copy
ActiveSheet.Paste Destination:=Range("G2:G" & i - 1)

End Sub
Sub データ連結()

Dim i As Integer
i = 1

Do Until ActiveSheet.Cells(i, 6).Value = ""



i = i + 1

Loop

Range("L2").Copy
ActiveSheet.Paste Destination:=Range("I2:I" & i - 1)

End Sub

Sub 条件表データ連結()

Dim i As Integer
i = 1

Worksheets("条件表").Select
Do Until ActiveSheet.Cells(i, 6).Value = ""



i = i + 1

Loop

Worksheets("本体").Select
Range("J2").Select

Range("M2").Copy
ActiveSheet.Paste Destination:=Range("J2:J" & i - 1)

ActiveCell.Offset(1, 0).Activate

Range("N2").Value = "=COUNTIF($J$2:$J$" & i & ",$I2)"

End Sub

Sub データ検索()

Dim i As Integer
i = 1

Do Until ActiveSheet.Cells(i, 6).Value = ""



i = i + 1

Loop
Range("N2").Copy
Dim myArray
myArray = Range("H2,H" & i)

ActiveSheet.Paste Destination:=Range("H2:H" & i - 1)

End Sub
Sub 自動判定()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim start, finish As Variant

start = Time

Application.Run "データ連結"
Application.Run "条件表データ連結"
Application.Run "データ検索"
Application.Run "判定"

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

finish = Time
MsgBox "取得が完了しました" & vbLf & "実行時間は" & Format(finish - start, "nn分ss秒") & "でした"
End Sub

～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～

④マクロの実行ボタンを作成

開発タブ→挿入→ボタン（左上にあります）を選択。

マクロの登録ウィンドウが出るので、自動判定を選択

ボタンを適当な位置に移動し（K列より右が良い）、シート完成。

⑤ブックを拡張子.xlsmで保存し、バックアップを作成しておく（関数などを壊してしまったときの対策）。

⑥本体と条件表にデータを入力してボタンを押すとマクロが実行され、判定結果が表示される。

以上