| |
▼亀マスター さん：
お答えを元にコードを修正したのですが、
目的の件数の取得ができませんでした。
いかに、現状のコードを記載いたしますので、
誤っている点がありましたら教えていただけませんでしょうか
現在、配列を使用していない状態のときのVBAと配列を使用した状態のVBAで件数が半分以下になっていますので、おそらく抽出条件で間違っているのかと思います
出力期間は
2018/1/1 開始
2018/2/1 終了
で実施しています
Option Explicit
Sub CSV_MATCH()
'指定期間内のログイン情報を抽出する
Debug.Print Time
Dim daily_num As Long
Dim master_num As Long
Dim daily_num2 As Long
Dim master_num2 As Long
Dim count_master As Long
Dim count_master2 As Long
Dim count_daily As Long
Dim count_daily2 As Long
Dim stdate As String
Dim eddate As String
Dim ary_cell() As Variant
Dim ary_cell2() As Variant
Dim mail_match As String
Dim mail_match2 As String
Dim mail_match3 As String
Dim mail_match4 As String
Dim arr_master As Variant
Dim arr_daily_o365_tmp As Variant
Dim arr_daily_o365_master As Variant
Dim arr_i As Long
Dim arr_j As Long
Dim ws_master As Worksheet
Dim ws_daily As Worksheet
Dim ws_match As Worksheet
Dim ws_btn As Worksheet
Dim ws_daily_tmp As Worksheet
Dim ws_daily_o365_tmp As Worksheet
Dim ws_daily_o365_master As Worksheet
Set ws_master = Worksheets("マスタCSV")
Set ws_daily = Worksheets("取り込みCSV")
Set ws_match = Worksheets("期間内利用ユーザ")
Set ws_btn = Worksheets("ボタン")
Set ws_daily_tmp = Worksheets("利用ユーザ一時保管") ⇒元はdaily2
Set ws_daily_o365_tmp = Worksheets("O365契約ユーザ") ⇒元はdaily3
Set ws_daily_o365_master = Worksheets("O365ユーザマスタ情報") ⇒元はmatch2
With Sheets("マスタCSV")
count_master = .UsedRange.Cells(.UsedRange.Rows.Count, 1).Row
End With
With Sheets("利用ユーザ一時保管")
count_daily = .UsedRange.Cells(.UsedRange.Rows.Count, 1).Row
End With
'ここからはws_dailyでの作業
ws_daily.Activate
'オートフィルタがかかっていない状態にする
ActiveSheet.AutoFilterMode = False
'抽出する日次情報の範囲を指定する
stdate = InputBox("ﾃﾞｰﾀ抽出開始日を入力してください。（2018/1/1形式で入力）")
eddate = InputBox("ﾃﾞｰﾀ抽出終了日を入力してください。（2018/1/1形式で入力）")
'=======(この範囲内は後日修正箇所 start)====================================
'日付範囲を指定したws_dailyの情報をws_daily_tmpへ貼り付ける
Range("A1").AutoFilter field:=6, Criteria1:=">=" & stdate, Operator:=xlAnd, Criteria2:="<=" & eddate
ws_daily.Range("A1").CurrentRegion.Copy ws_daily_tmp.Range("A1")
ws_daily.AutoFilterMode = False
'ws_daily_tmpに記載のメールアドレスとws_masterに記載のメールアドレスと付き合わせる
For master_num = 1 To count_master
For daily_num = 1 To count_daily
mail_match = ws_master.Range("D" & master_num)
mail_match2 = ws_daily_tmp.Range("B" & daily_num)
If mail_match2 = mail_match Then
ws_match.Range("A" & daily_num).Value = ws_master.Range("B" & master_num).Value
ws_match.Range("B" & daily_num).Value = ws_master.Range("D" & master_num).Value
ws_match.Range("C" & daily_num).Value = ws_master.Range("G" & master_num).Value
ws_match.Range("D" & daily_num).Value = ws_master.Range("I" & master_num).Value
ws_match.Range("E" & daily_num).Value = ws_master.Range("L" & master_num).Value
ws_match.Range("F" & daily_num).Value = ws_master.Range("M" & master_num).Value
ws_match.Range("G" & daily_num).Value = ws_master.Range("N" & master_num).Value
Exit For
End If
Next
Next
'ここからはws_matchでの作業
ws_match.Activate
'抽出した情報を部署単位で並び替える
ws_match.Range("A:K").Sort Key1:=Range("D1"), order1:=xlAscending
'=======(この範囲内は後日修正箇所 end)====================================
'ここからはシートws_dailyでの作業
ws_daily.Activate
'1.ws_daily内で「D列がfalse」をws_daily_o365_tmpに貼り付ける
With ws_daily.UsedRange
.AutoFilter field:=4, Criteria1:=False
.Copy ws_daily_o365_tmp.Range("A1")
End With
ws_daily.AutoFilterMode = False
'2.ws_daily内で「D列が指定期間内」をws_daily_o365_tmpに貼り付ける
Range("A1").AutoFilter field:=6, Criteria1:=">=" & stdate, Operator:=xlAnd, Criteria2:="<=" & eddate
Rows(1).Hidden = True
ws_daily.Range("A1").CurrentRegion.Copy ws_daily_o365_tmp.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ws_daily.AutoFilterMode = False
Rows(1).Hidden = False
'1.と2.で重複したレコードを削除する
ws_daily_o365_tmp.Range("A:K").RemoveDuplicates Columns:=Array(2), Header:=xlNo
'タイトル行を削除する
ws_daily_o365_tmp.Rows(1).Delete
'メールアドレスでソートする
'ws_daily_o365_tmp.Range("A:K").Sort Key1:=Range("B1"), order1:=xlAscending
With Worksheets("O365契約ユーザ")
.Range("A:N").Sort Key1:=.Range("B1"), order1:=xlAscending
End With
'count_master2はAD情報のレコード件数
With Sheets("マスタCSV")
count_master2 = .UsedRange.Cells(.UsedRange.Rows.Count, 1).Row
End With
'count_daily2はws_daily_o365_tmpのレコード件数
With Sheets("O365契約ユーザ")
count_daily2 = .UsedRange.Cells(.UsedRange.Rows.Count, 1).Row
End With
'ws_daily_o365_tmpのデータを配列に格納
arr_daily_o365_tmp = Worksheets("O365契約ユーザ").UsedRange
'ws_daily_o365_masterのデータ（この時点では空白）を配列に格納
'（行数はarr_daily_o365_tmpと同じにする）
With Worksheets("O365ユーザマスタ情報")
arr_daily_o365_master = .Range(.Cells(1, "A"), .Cells(UBound(arr_daily_o365_tmp), "N"))
End With
'masterシートのデータを配列に格納
arr_master = Worksheets("マスタCSV").UsedRange
'daily3シートのデータでmasterシートに該当するものを見つけて情報を転記
'（ここからセルを直接操作するのではなく配列を使っている）
For arr_i = 1 To UBound(arr_daily_o365_tmp)
Application.StatusBar = "処理実行中．．．．(現在 " & arr_i & "件)"
For arr_j = 1 To UBound(arr_daily_o365_master)
If arr_daily_o365_tmp(arr_i, 2) = arr_master(arr_j, 4) Then
arr_daily_o365_master(arr_i, 1) = arr_master(arr_j, 2)
arr_daily_o365_master(arr_i, 2) = arr_master(arr_j, 4)
arr_daily_o365_master(arr_i, 3) = arr_master(arr_j, 7)
arr_daily_o365_master(arr_i, 4) = arr_master(arr_j, 9)
arr_daily_o365_master(arr_i, 5) = arr_master(arr_j, 12)
arr_daily_o365_master(arr_i, 6) = arr_master(arr_j, 13)
arr_daily_o365_master(arr_i, 7) = arr_master(arr_j, 14)
Exit For
End If
Next arr_j
Next arr_i
Application.StatusBar = "処理完了．．．．(全 " & arr_i & "件)"
With Worksheets("O365ユーザマスタ情報")
.Range(.Cells(1, "A"), .Cells(UBound(arr_daily_o365_tmp), "N")) = arr_daily_o365_master
End With
ws_daily_o365_master.Range("A:N").RemoveDuplicates Columns:=Array(2), Header:=xlNo
With Worksheets("O365ユーザマスタ情報")
.Range("A:N").Sort Key1:=.Range("D1"), order1:=xlAscending
End With
' For master_num2 = 1 To count_master2
' For daily_num2 = 1 To count_daily2
' mail_match3 = ws_master.Range("D" & master_num2)
' mail_match4 = ws_daily_o365_tmp.Range("B" & daily_num2)
' If mail_match4 = mail_match3 Then
' If ws_daily_o365.Range("B" & daily_num2).Value = ws_master.Range("D" & master_num2).Value Then
' ws_daily_o365_master.Range("A" & daily_num2).Value = ws_master.Range("B" & master_num2).Value
' ws_daily_o365_master.Range("B" & daily_num2).Value = ws_master.Range("D" & master_num2).Value
' ws_daily_o365_master.Range("C" & daily_num2).Value = ws_master.Range("G" & master_num2).Value
' ws_daily_o365_master.Range("D" & daily_num2).Value = ws_master.Range("I" & master_num2).Value
' ws_daily_o365_master.Range("E" & daily_num2).Value = ws_master.Range("L" & master_num2).Value
' ws_daily_o365_master.Range("F" & daily_num2).Value = ws_master.Range("M" & master_num2).Value
' ws_daily_o365_master.Range("G" & daily_num2).Value = ws_master.Range("N" & master_num2).Value
' Exit For
' End If
' Next
' Next
'初期画面に戻る
ws_btn.Activate
Debug.Print Time
End Sub
|
|
amatsuno
- 18/2/23(金) 15:53 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
