Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


375 / 74374 ←次へ | 前へ→

【79640】Re:指定期間でログインしたユーザーを知りたい ...
発言  amatsuno  - 18/2/23(金) 15:53 -

引用なし
パスワード
   ▼亀マスター さん:
お答えを元にコードを修正したのですが、
目的の件数の取得ができませんでした。

いかに、現状のコードを記載いたしますので、
誤っている点がありましたら教えていただけませんでしょうか

現在、配列を使用していない状態のときの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

67 hits

【79618】指定期間でログインしたユーザーを知りたい ... amatsuno 18/2/14(水) 16:19 質問[未読]
【79619】Re:指定期間でログインしたユーザーを知り... 亀マスター 18/2/14(水) 21:03 回答[未読]
【79620】Re:指定期間でログインしたユーザーを知り... amatsuno 18/2/15(木) 13:36 お礼[未読]
【79627】Re:指定期間でログインしたユーザーを知り... amatsuno 18/2/20(火) 16:36 質問[未読]
【79633】Re:指定期間でログインしたユーザーを知り... 亀マスター 18/2/21(水) 22:38 回答[未読]
【79640】Re:指定期間でログインしたユーザーを知り... amatsuno 18/2/23(金) 15:53 発言[未読]
【79646】Re:指定期間でログインしたユーザーを知り... 亀マスター 18/2/23(金) 22:55 発言[未読]
【79650】Re:指定期間でログインしたユーザーを知り... amatsuno 18/2/26(月) 16:07 発言[未読]
【79651】Re:指定期間でログインしたユーザーを知り... 亀マスター 18/2/26(月) 18:53 発言[未読]
【79654】Re:指定期間でログインしたユーザーを知り... amatsuno 18/2/27(火) 17:56 お礼[未読]
【79641】Re:指定期間でログインしたユーザーを知り... amatsuno 18/2/23(金) 15:55 発言[未読]
【79642】Re:指定期間でログインしたユーザーを知り... amatsuno 18/2/23(金) 15:59 発言[未読]

375 / 74374 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free