前回の続きで今回は実際にマクロを書いていきます。
今回作るマクロ
前回のおさらいですが、
依頼内容は
データベースの情報を条件ごとに振り分ける
という話をしました。
実際の処理としてはシンプルで
１．シート「抽出データ」のデータを取得する
の2点。
ただこの「条件」の作り方が今回のポイントでIF文ではなく、各カラムの情報①～④を繋げて判定する方法で行きたいと思います。
まずは全体像です。
本当はデータベースからデータをとって分類し、最後エクセルのファイルで出力するのですが、今回はシート「抽出データ」にある架電内容のデータを各シート「パターンA」～「パターンL」に情報を転記するマクロとしました。
次にマクロの全体です。
Sub Sample2()
Dim intSheet As Integer '/--シート番号--/'
Dim strSheetName As String '/--シート名--/'
Dim lngMaxY As Long '/--シート「抽出データ」の最大行数--/'
Dim lngY As Long '/--行周回用カウンタ--/'
Dim lngMaxY2 As Long '/--転記先シートの最大行数--/'
Dim intMaxX As Integer '/--シート「抽出データ」の最大列数--/'
Dim intX As Integer '/--列周回用カウンタ--/'
Dim strKaden As String '/--架電理由--/'
Dim strKoutei As String '/--工程名称--/'
Dim strNAT As String '/--NAT--/'
Dim strIshi As String '/--意思確認--/'
Dim strHantei As String '/--条件判定--/'
'/--シート「抽出データ」の最大行数・最大列数を取得--/'
lngMaxY = Sheets("抽出データ").Cells(Rows.Count, 1).End(xlUp).Row
intMaxX = Sheets("抽出データ").Cells(1, Columns.Count).End(xlToLeft).Column
'/--カラム名を各シートに転記--/'
For intSheet = 2 To ActiveWorkbook.Sheets.Count
For intX = 1 To intMaxX
Sheets(intSheet).Cells(1, intX).Value = Sheets("抽出データ").Cells(1, intX).Value
Next intX
Next intSheet
'/--シート「抽出データ」の最大行数分周回--/'
For lngY = 2 To lngMaxY
strSheetName = ""
strKaden = "0"
strKoutei = "0"
strNAT = "0"
strIshi = "0"
strHantei = "0000"
strKaden = Sheets("抽出データ").Cells(lngY, 1).Value
strKoutei = Sheets("抽出データ").Cells(lngY, 15).Value
strNAT = Sheets("抽出データ").Cells(lngY, 19).Value
strIshi = Sheets("抽出データ").Cells(lngY, 20).Value
'/--架電理由の条件格納--/'
Select Case strKaden
Case "自動更新"
strKaden = "1"
Case "OB対象外"
strKaden = "1"
Case "審査"
strKaden = "1"
Case "電話・資料請求"
strKaden = "2"
Case "窓口（新規）"
strKaden = "3"
Case "不明"
strKaden = "4"
Case "乗換"
strKaden = "4"
Case "利用率高"
strKaden = "4"
Case "未成年"
strKaden = "4"
Case "ハイクラス"
strKaden = "5"
Case Else
strKaden = "9"
End Select
'/--工程名称の条件格納--/'
Select Case strKoutei
Case "電話・本人宛NAT"
strKoutei = "1"
Case "電話・事前不備有"
strKoutei = "2"
Case "電話・本人宛不備"
strKoutei = "3"
Case "電話・同意"
strKoutei = "4"
Case "電話・資料請求"
strKoutei = "5"
Case Else
strKoutei = "9"
End Select
'/--NATの条件格納--/'
If strNAT = "" Then
strNAT = "1"
Else
strNAT = "9"
End If
'/--意思確認の条件格納--/'
If strIshi = "1" Then
strIshi = "1"
Else
strIshi = "9"
End If
'/--各条件を結合--/'
strHantei = strKaden & strKoutei & strNAT & strIshi
'/--条件によるパターン判定--/'
Select Case Left(strHantei, 2)
Case "11"
Select Case strHantei
Case "1111"
strSheetName = "パターンA"
Case Else
strSheetName = "パターンL"
End Select
Case "12"
strSheetName = "パターンB"
Case "13"
strSheetName = "パターンC"
Case "14"
strSheetName = "パターンD"
Case "15"
strSheetName = "パターンE"
Case "21"
strSheetName = "パターンG"
Case "22"
strSheetName = "パターンH"
Case "23"
strSheetName = "パターンF"
Case Else
Select Case Left(strHantei, 1)
Case "3"
strSheetName = "パターンI"
Case "4"
strSheetName = "パターンJ"
Case "5"
strSheetName = "パターンK"
Case Else
strSheetName = "パターンL"
End Select
End Select
'/--転記先シートの最大行数を取得--/'
lngMaxY2 = Sheets(strSheetName).Cells(Rows.Count, 1).End(xlUp).Row + 1
'/--転記先シートへデータを転記--/'
For intX = 1 To intMaxX
Sheets(strSheetName).Cells(lngMaxY2, intX).Value = Sheets("抽出データ").Cells(lngY, intX).Value
Next intX
Next lngY
End Sub
それぞれのパートで説明すると
'/--シート「抽出データ」の最大行数・最大列数を取得--/'
lngMaxY = Sheets("抽出データ").Cells(Rows.Count, 1).End(xlUp).Row
intMaxX = Sheets("抽出データ").Cells(1, Columns.Count).End(xlToLeft).Columnここはシート「抽出データ」の1列目の値がある最終行と1行目の値がある最終列を取得しています。
まず
.Cells(Rows.Count, 1).End(xlUp).Row
ですが、
Row.Count：Excelの最後の行（1048576）
1 ：1列目
.End(xlUp)：最後の行から上方向に
.Row ：値のある行番号をとる
こんな意味となります。
.Cells(1, Columns.Count).End(xlToLeft).Column
ここもほとんど同じで
Columns.Count：Excelの最後の列（16384）
.End(xlToLeft) ：最後の列から左方向に
.Column ：値のある列番号をとる
こんな意味となります。
'/--架電理由の条件格納--/'
Select Case strKaden
Case "自動更新"
strKaden = "1"
Case "OB対象外"
strKaden = "1"
Case "審査"
strKaden = "1"
Case "電話・資料請求"
strKaden = "2"
Case "窓口（新規）"
strKaden = "3"
Case "不明"
strKaden = "4"
Case "乗換"
strKaden = "4"
Case "利用率高"
strKaden = "4"
Case "未成年"
strKaden = "4"
Case "ハイクラス"
strKaden = "5"
Case Else
strKaden = "9"
End Selectここは①架電理由を1～5、9で分類してstrKadenに入れています。
同様にstrKoutei（工程名称）、strNAT（NAT）、strIshi（意思確認）も下図の条件に合わせて分類していきます。
'/--各条件を結合--/'
strHantei = strKaden & strKoutei & strNAT & strIshi
'/--条件によるパターン判定--/'
Select Case Left(strHantei, 2)
Case "11"
Select Case strHantei
Case "1111"
strSheetName = "パターンA"
Case Else
strSheetName = "パターンL"
End Select
Case "12"
strSheetName = "パターンB"
Case "13"
strSheetName = "パターンC"
Case "14"
strSheetName = "パターンD"
Case "15"
strSheetName = "パターンE"
Case "21"
strSheetName = "パターンG"
Case "22"
strSheetName = "パターンH"
Case "23"
strSheetName = "パターンF"
Case Else
Select Case Left(strHantei 1)
Case "3"
strSheetName = "パターンI"
Case "4"
strSheetName = "パターンJ"
Case "5"
strSheetName = "パターンK"
Case Else
strSheetName = "パターンL"
End Select
End Select
ここからは実際にA~Lのパターン分けになります
①②③④を繋げたstrHanteiがどうだったか？をSelect文で分類していますが、
①②③④の値が
1111・・・パターンＡ
12xx・・・パターンＢ（xはどの値でもよい）
13xx・・・パターンＣ
14xx・・・パターンＤ
15xx・・・パターンＥ
23xx・・・パターンＦ
21xx・・・パターンＧ
22xx・・・パターンＨ
3xxx・・・パターンＩ
4xxx・・・パターンＪ
5xxx・・・パターンＫ
それ以外・・パターンＬ
となります。
ここでポイントですが、パターンＡ、Ｉ～Ｋ以外は①②で判定できる。という点です。
なので基本は
Select Case Left(strHantei, 2)
で左2文字分で判定し、
Left(strHantei, 2)の値が”11”の時は
Select Case strHantei
Case "1111"
strSheetName = "パターンA"
Case Else
strSheetName = "パターンL"
End Selectで4文字全てを条件とし、逆にLeft(strHantei 2)の値が”23”以降であれば
Select Case Left(strHantei, 1)
Case "3"
strSheetName = "パターンI"
Case "4"
strSheetName = "パターンJ"
Case "5"
strSheetName = "パターンK"
Case Else
strSheetName = "パターンL"
End Selectで左1文字だけで判定することでパターンＡ～Ｌの全てを分類できるようになります。
'/--転記先シートの最大行数を取得--/'
lngMaxY2 = Sheets(strSheetName).Cells(Rows.Count, 1).End(xlUp).Row + 1
'/--転記先シートへデータを転記--/'
For intX = 1 To intMaxX
Sheets(strSheetName).Cells(lngMaxY2, intX).Value = Sheets("抽出データ").Cells(lngY, intX).Value
Next intXで最後は転記先のシートの最大行数を取得して、その1つ下（+1）したところに、その行の値を転記して1行分が終了します。
あとはそれをシート「抽出データ」の全レコードで実施して終了になります。
これで案件２の紹介は終了します。
↓よろしければクリックをお願いします！
