Excel VBA質問箱 IV

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

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


1 / 3701 ページ 前へ→

【79647】Re:住所をいい感じに区切る
回答[NEW]  γ  - 18/2/24(土) 10:43 -

引用なし
パスワード
   カンマで文節を区切ったうえで、それぞれの文字数をカウントしておきます。

4行になるものとし、各行の最後の文節のインデックスを、定めればよいわけです。
それらを k1,k2,k3,n (n はこの場合6です)とすると、
5個のなかから3個を取り出す組み合わせですから、10ケースです。
それを しらみつぶし に検証すればよいだけです。

例えば、こんな感じ。

  '組み合わせを列挙。
  '4行になるものとし、各行に含まれる最後の文節のインデックスを、
  'それぞれ、k1,k2,k3,n として、すべての組み合わせを列挙します。
  
  myMin = 1000
  For k1 = 1 To n - 3
    For k2 = k1 + 1 To n - 2
      For k3 = k2 + 1 To n - 1
        '各区分の長さの最大値を最小となる組み合わせを調べます
        以下略

もう解決したと思いますが。
・ツリー全体表示

【79646】Re:指定期間でログインしたユーザーを知...
発言[NEW]  亀マスター  - 18/2/23(金) 22:55 -

引用なし
パスワード
   思っていた件数にならないとのことですが、具体的にはどのシートで何件抽出されるのが狙いでしょうか。

私が手元で試したところ、提示していただいたサンプルデータでは、「期間内利用ユーザ」シートに12件+13行目にタイトル行が入った状態になりました。
「期間内利用ユーザ」シートには、指定された期間に該当し、「利用ユーザ一時保管」シートで4列目がFALSEになっているものを抽出するのだと思いますが、その件がおかしいということであれば、「マスタCSV」シートにないメールアドレスが「取り込みCSV」にあるからだと思います。

その他、新しく追加した「O365契約ユーザ」と「O365ユーザマスタ情報」ではどのような情報が抽出されることを想定しているのでしょうか。
・ツリー全体表示

【79645】Re:オートフィルター抽出行の削除
発言  Jaka  - 18/2/23(金) 19:09 -

引用なし
パスワード
   質問に書いてあったので引用

.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).deleat shift:=xlUp
・ツリー全体表示

【79644】Re:オートフィルター抽出行の削除
発言  Jaka  - 18/2/23(金) 19:03 -

引用なし
パスワード
   ああ、

Select
って書いちゃったけど、直接 Deliteしても良いかも。
(スペルあっているか不明)

上か右にシフトして削除とかは、マクロ記録してください。
・ツリー全体表示

【79643】Re:オートフィルター抽出行の削除
発言  Jaka  - 18/2/23(金) 18:47 -

引用なし
パスワード
   これだけで解るかな?

With Rng
   .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Select
End With
・ツリー全体表示

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

引用なし
パスワード
   (マスタCSV)シート「ws_master」に貼り付け


Mcol-1,Mcol-2,Mcol-3,Mcol-4,Mcol-5,Mcol-6,Mcol-7,Mcol-8,Mcol-9,Mcol-10,Mcol-11,Mcol-12,Mcol-13,Mcol-14,Mcol-15
Mod,TST43045,TST4,test11@mailtest.co.jp,1043045,1.00E+12,100,10012,1001214,100121024,10012102420,株式会社テスト社名,,114出力部署テスト,出力部署テスト名称正式名部
Mod,TST43046,TST5,test12@mailtest.co.jp,1043046,1.00E+12,100,10012,1001210,100121024,10012102420,株式会社テスト社名,,110出力部署テスト,出力部署テスト名称正式名部
Mod,TST43047,TST6,test13@mailtest.co.jp,1043047,1.00E+12,100,10012,1001211,100121024,10012102420,株式会社テスト社名,,111出力部署テスト,出力部署テスト名称正式名部
Mod,TST43048,TST7,test14@mailtest.co.jp,1043048,1.00E+12,100,10012,1001211,100121024,10012102420,株式会社テスト社名,,111出力部署テスト,出力部署テスト名称正式名部
Mod,TST43049,TST8,test15@mailtest.co.jp,1043049,1.00E+12,100,10012,1001212,100121024,10012102420,株式会社テスト社名,,112出力部署テスト,出力部署テスト名称正式名部
Mod,TST43050,TST4,test16@mailtest.co.jp,1043050,1.00E+12,100,10012,1001212,100121024,10012102420,株式会社テスト社名,,112出力部署テスト,出力部署テスト名称正式名部
Mod,TST43051,TST5,test17@mailtest.co.jp,1043051,1.00E+12,100,10012,1001213,100121024,10012102420,株式会社テスト社名,,113出力部署テスト,出力部署テスト名称正式名部
Mod,TST43052,TST6,test18@mailtest.co.jp,1043052,1.00E+12,100,10012,1001211,100121024,10012102420,株式会社テスト社名,,111出力部署テスト,出力部署テスト名称正式名部
Mod,TST43053,TST7,test19@mailtest.co.jp,1043053,1.00E+12,100,10012,1001213,100121024,10012102420,株式会社テスト社名,,113出力部署テスト,出力部署テスト名称正式名部
Mod,TST43054,TST8,test20@mailtest.co.jp,1043054,1.00E+12,100,10012,1001214,100121024,10012102420,株式会社テスト社名,,114出力部署テスト,出力部署テスト名称正式名部
Mod,TST43055,TST4,test21@mailtest.co.jp,1043055,1.00E+12,100,10012,1001214,100121024,10012102420,株式会社テスト社名,,114出力部署テスト,出力部署テスト名称正式名部
Mod,TST43056,TST4,test22@mailtest.co.jp,1043056,1.00E+12,100,10012,1001215,100121024,10012102420,株式会社テスト社名,,115出力部署テスト,出力部署テスト名称正式名部
Mod,TST43045,TST4,test23@mailtest.co.jp,1043045,1.00E+12,200,10012,2001214,100121024,10012102420,AA株式会社テスト社名,,214出力部署テスト,出力部署テスト名称正式名部
Mod,TST43046,TST5,test24@mailtest.co.jp,1043046,1.00E+12,200,10012,2001210,100121024,10012102420,AA株式会社テスト社名,,210出力部署テスト,出力部署テスト名称正式名部
Mod,TST43047,TST6,test25@mailtest.co.jp,1043047,1.00E+12,200,10012,2001211,100121024,10012102420,AA株式会社テスト社名,,211出力部署テスト,出力部署テスト名称正式名部
Mod,TST43048,TST7,test26@mailtest.co.jp,1043048,1.00E+12,200,10012,2001211,100121024,10012102420,AA株式会社テスト社名,,211出力部署テスト,出力部署テスト名称正式名部
Mod,TST43049,TST8,test27@mailtest.co.jp,1043049,1.00E+12,200,10012,2001212,100121024,10012102420,AA株式会社テスト社名,,212出力部署テスト,出力部署テスト名称正式名部
Mod,TST43050,TST4,test28@mailtest.co.jp,1043050,1.00E+12,200,10012,2001212,100121024,10012102420,AA株式会社テスト社名,,212出力部署テスト,出力部署テスト名称正式名部
Mod,TST43051,TST5,test29@mailtest.co.jp,1043051,1.00E+12,200,10012,2001213,100121024,10012102420,AA株式会社テスト社名,,213出力部署テスト,出力部署テスト名称正式名部
Mod,TST43052,TST6,test30@mailtest.co.jp,1043052,1.00E+12,200,10012,2001211,100121024,10012102420,AA株式会社テスト社名,,211出力部署テスト,出力部署テスト名称正式名部
Mod,TST43053,TST7,test31@mailtest.co.jp,1043053,1.00E+12,200,10012,2001213,100121024,10012102420,AA株式会社テスト社名,,213出力部署テスト,出力部署テスト名称正式名部
Mod,TST43054,TST8,test32@mailtest.co.jp,1043054,1.00E+12,200,10012,2001214,100121024,10012102420,AA株式会社テスト社名,,214出力部署テスト,出力部署テスト名称正式名部
Mod,TST43055,TST4,test33@mailtest.co.jp,1043055,1.00E+12,200,10012,2001214,100121024,10012102420,AA株式会社テスト社名,,214出力部署テスト,出力部署テスト名称正式名部
Mod,TST43056,TST4,test34@mailtest.co.jp,1043056,1.00E+12,200,10012,2001215,100121024,10012102420,AA株式会社テスト社名,,215出力部署テスト,出力部署テスト名称正式名部
Mod,TST43056,TST4,test35@mailtest.co.jp,1043056,1.00E+12,100,10012,2001210,100121024,10012102420,AA株式会社テスト社名,,215出力部署テスト,出力部署テスト名称正式名部
Mod,TST43046,TST5,test36@mailtest.co.jp,1043046,1.00E+12,100,10012,1001210,100121024,10012102420,株式会社テスト社名,,210出力部署テスト,出力部署テスト名称正式名部
Mod,TST43046,TST5,test37@mailtest.co.jp,1043046,1.00E+12,100,10012,1001210,100121024,10012102420,株式会社テスト社名,,210出力部署テスト,出力部署テスト名称正式名部
Mod,TST43045,TST4,test38@mailtest.co.jp,1043045,1.00E+12,100,10012,1001214,100121024,10012102420,株式会社テスト社名,,114出力部署テスト,出力部署テスト名称正式名部
Mod,TST43046,TST5,test39@mailtest.co.jp,1043046,1.00E+12,100,10012,1001210,100121024,10012102420,株式会社テスト社名,,110出力部署テスト,出力部署テスト名称正式名部
Mod,TST43047,TST6,test40@mailtest.co.jp,1043047,1.00E+12,100,10012,1001211,100121024,10012102420,株式会社テスト社名,,111出力部署テスト,出力部署テスト名称正式名部
Mod,TST43048,TST7,test41@mailtest.co.jp,1043048,1.00E+12,100,10012,1001211,100121024,10012102420,株式会社テスト社名,,111出力部署テスト,出力部署テスト名称正式名部
Mod,TST43049,TST8,test42@mailtest.co.jp,1043049,1.00E+12,100,10012,1001212,100121024,10012102420,株式会社テスト社名,,112出力部署テスト,出力部署テスト名称正式名部
Mod,TST43050,TST4,test43@mailtest.co.jp,1043050,1.00E+12,100,10012,1001212,100121024,10012102420,株式会社テスト社名,,112出力部署テスト,出力部署テスト名称正式名部
Mod,TST43051,TST5,test44@mailtest.co.jp,1043051,1.00E+12,100,10012,1001213,100121024,10012102420,株式会社テスト社名,,113出力部署テスト,出力部署テスト名称正式名部
Mod,TST43052,TST6,test45@mailtest.co.jp,1043052,1.00E+12,100,10012,1001211,100121024,10012102420,株式会社テスト社名,,111出力部署テスト,出力部署テスト名称正式名部
Mod,TST43053,TST7,test46@mailtest.co.jp,1043053,1.00E+12,100,10012,1001213,100121024,10012102420,株式会社テスト社名,,113出力部署テスト,出力部署テスト名称正式名部
Mod,TST43054,TST8,test47@mailtest.co.jp,1043054,1.00E+12,100,10012,1001214,100121024,10012102420,株式会社テスト社名,,114出力部署テスト,出力部署テスト名称正式名部
Mod,TST43055,TST4,test48@mailtest.co.jp,1043055,1.00E+12,100,10012,1001214,100121024,10012102420,株式会社テスト社名,,114出力部署テスト,出力部署テスト名称正式名部
Mod,TST43056,TST4,test49@mailtest.co.jp,1043056,1.00E+12,100,10012,1001215,100121024,10012102420,株式会社テスト社名,,115出力部署テスト,出力部署テスト名称正式名部
・ツリー全体表示

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

引用なし
パスワード
   (取り込みCSV)シート「ws_daily」に貼り付け

col-1,col-2,col-3,col-4,col-5,col-6,col-7,col-8,col-9,col-10,col-11
2018/2/14,test14@mailtest.co.jp,,FALSE,,2018/1/9,58,275,275,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test17@mailtest.co.jp,,FALSE,,2018/1/9,102,1469,1523,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test20@mailtest.co.jp,,FALSE,,2018/1/29,127,930,887,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test23@mailtest.co.jp,,FALSE,,2018/1/9,10,89,71,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test26@mailtest.co.jp,,FALSE,,2018/1/29,138,695,630,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test29@mailtest.co.jp,,FALSE,,2018/1/9,0,46,42,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test32@mailtest.co.jp,,TRUE,,2018/1/9,7,390,193,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test35@mailtest.co.jp,,FALSE,,2018/1/29,76,550,494,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test38@mailtest.co.jp,,FALSE,,2018/1/9,81,1000,983,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test41@mailtest.co.jp,,FALSE,,2018/1/9,193,1647,1449,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test44@mailtest.co.jp,,FALSE,,2018/1/9,249,1312,1002,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test47@mailtest.co.jp,,FALSE,,2018/1/9,566,1227,1375,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test50@mailtest.co.jp,,TRUE,,2018/1/9,134,785,610,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test53@mailtest.co.jp,,FALSE,,2018/1/29,35,207,213,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test56@mailtest.co.jp,,FALSE,,2018/1/9,184,558,384,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test59@mailtest.co.jp,,TRUE,,2017/12/11,228,923,564,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test62@mailtest.co.jp,,TRUE,,2018/1/9,124,563,561,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test65@mailtest.co.jp,,TRUE,,2017/12/11,124,687,408,OFFICE 365 ENTERPRISE E4,30
2018/2/14,test68@mailtest.co.jp,,FALSE,,2018/1/9,1,170,65,OFFICE 365 ENTERPRISE E4,30
・ツリー全体表示

【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
・ツリー全体表示

【79639】オートフィルター抽出行の削除
質問  nao  - 18/2/23(金) 13:18 -

引用なし
パスワード
   いつもお世話になっております。
現在、オートフィルターをかけて抽出した行を削除したいのですがエラーがでてしまい
何が悪いのかわかりません。
オートフィルターにて抽出まではできるのですが、削除の部分でエラーがでてしまい
とまってしまいます(><)

  Dim DepCode As String
  Dim Rng As Range
  
  ActiveWorkbook.Worksheets("2.").Select
  
  Set Rng = Range("B2:AG2").CurrentRegion
  Rng.AutoFilter 
  
  DepCode = Sheets(1).Range("B4")

  Rng.AutoFilter Field:=7, Criteria1:="<>" & DepCode & "*"  ←抽出


  Rows("3:3").Select  ←3行目から抽出後の行を削除
  Range(Selection.End(xlDown)).Select
  '対象外のレコードをクリア
  Selection.deleat shift:=xlUp
  Selection.AutoFilter

ご教示宜しくお願いします。
  
・ツリー全体表示

【79637】Re:住所をいい感じに区切る
お礼  りった  - 18/2/22(木) 10:53 -

引用なし
パスワード
   回答ありがとうございます。
・ツリー全体表示

【79636】Re:ああ、まただ。
お礼  nao  - 18/2/22(木) 9:42 -

引用なし
パスワード
   ▼Jaka さん:
おはようございます。
ありがとうございます。
無事に解決できました!"&r&"でいれてあげればよいんですね!
その辺がうまく出来ずに悩んでおりました。
ありがとうございます!                      ↑
・ツリー全体表示

【79635】Re:住所をいい感じに区切る
発言  γ  - 18/2/22(木) 0:07 -

引用なし
パスワード
   余り難しく考えずに、
すべての組み合わせを検証する
いわゆる"貪欲法"でいったらどうでしょうか。
計算そのものは、さして難しくないはずです。
・ツリー全体表示

【79634】ああ、まただ。
発言  Jaka  - 18/2/21(水) 22:59 -

引用なし
パスワード
   >これと、",E$4,[★DATA.xlsx]ローデータ!$C$3:$C$" & y & _
>これの、",E$4,[★DATA.xlsx]ローデータ!$C$3:$C$" & y & _

  ↓
                         ↓
これと、",E$4,[★DATA.xlsx]ローデータ!$C$3:$C$" & y & _
これの、",E$4,[" & 星ブック名 & "]ローデータ!$C$3:$C$" & y & _
                             ↑
・ツリー全体表示

【79633】Re:指定期間でログインしたユーザーを知...
回答  亀マスター  - 18/2/21(水) 22:38 -

引用なし
パスワード
   回答が遅くなって済みません。

>格納したい当該の箇所は、取得前と取得後の抽出対象列が異なっています。
抽出元のシートでA列だった情報を抽出先のシートでB列に入れるというようなことでしょうか?
でしたら、既に作成されている二重ループの部分でそれは問題なくできているので、大丈夫ですよ。
そういう意図でないということでしたら連絡ください。

今回、配列にすべきはループの中で何度も読み取りあるいは書き込みをしているシートで、具体的にはmaster、daily3、matchの3つのシートです。
そこで、これらのシートのデータを格納する変数を
arr_master、arr_daily3、arr_matchとして、以下のようにします。
以前に提示していただいたコードをベースに修正しています。(変更していない部分は示していません)

Dim arr_master As Variant
Dim arr_daily3 As Variant
Dim arr_match As Variant
Dim i As Long, j As Long

'元々のコードで Worksheets("daily2").Activate から始まる部分ですが、
'ここでもセルの読み書きが発生しています。
'ただ、ここはエクセルのオートフィルを使えばループを回さなくても簡単にできるので
'このように修正しています。
With ws_daily2.UsedRange
  .AutoFilter field:=4, Criteria1:=False
  .Copy ws_daily3.Range("A1")
End With
Worksheets("daily2").AutoFilterMode = False


'daily3シートのデータを配列に格納
arr_daily3 = Worksheets("daily3").UsedRange

'matchシートのデータ(この時点では空白)を配列に格納
'(行数はdaily3と同じにする)
With Worksheets("match")
  arr_match = .Range(.Cells(1, "A"), .Cells(UBound(arr_daily3), "D"))
End With

'masterシートのデータを配列に格納
arr_master = Worksheets("master").UsedRange

'daily3シートのデータでmasterシートに該当するものを見つけて情報を転記
'(ここからセルを直接操作するのではなく配列を使っている)
For i = 2 To UBound(arr_daily3)
  Application.StatusBar = "処理実行中....(現在 " & i & "件)"
  For j = 2 To UBound(arr_master)
    If arr_daily3(i, 2) = arr_master(j, 4) Then
      arr_match(i, 1) = arr_master(j, 2)
      arr_match(i, 2) = arr_master(j, 4)
      arr_match(i, 3) = arr_master(j, 3)
      arr_match(i, 4) = arr_master(j, 1)
      Exit For
    End If
  Next j
Next i

'matchシートに見出しをセット
arr_match(1, 1) = arr_master(1, 2)
arr_match(1, 2) = arr_master(1, 4)
arr_match(1, 3) = arr_master(1, 3)
arr_match(1, 4) = arr_master(1, 1)

'(見出し列の分とNextでカウントが1つ増える分、マイナスは2にしています)
Application.StatusBar = "処理完了....(全 " & i - 2 & "件)"

'matchシートに配列場のデータを転記
With Worksheets("match")
  .Range(.Cells(1, "A"), .Cells(UBound(arr_daily3), "D")) = arr_match
End With

'(matchシートをアクティブにする操作を省いているので、代わりにこのような書き方にしています)
With Worksheets("match")
  .Range("A:D").Sort key1:=.Range("D1"), Order1:=xlAscending
End With


※提示していただいたコードで
If ws_daily2.Range("B" & daily_num).Value = mail_match Then
とありましたが、ws_daily3ではないでしょうか?(以前のものではそうでしたので)
・ツリー全体表示

【79632】あっ!
発言  Jaka  - 18/2/21(水) 22:18 -

引用なし
パスワード
   すみません。、

これと、",E$4,[★DATA.xlsx]ローデータ!$C$3:$C$" & y & _
これの、",E$4,[★DATA.xlsx]ローデータ!$C$3:$C$" & y & _
                         ↑
y は、打ち間違いしてます。
r に変えてください。

下手に削除すると、空白のファイルができて、前みたいに繋がらなくなるかもしれないので。
・ツリー全体表示

【79631】Re:関数を使用して他BOOKからの最終行の...
発言  Jaka  - 18/2/21(水) 21:57 -

引用なし
パスワード
   文字列の連結ってできますか?

数式をマクロで書き込む時も、結局文字列なんですよ。

"=SUMIFS([★DATA.xlsx]ローデータ!$AG$3:$AG$999999,[★DATA.xlsx]ローデータ!$AH$3:$AH$999999,E$4,[★DATA.xlsx]ローデータ!$C$3:$C$999999,$D6,[★DATA.xlsx]ローデータ!$AK$3:$AK$999999,$B$4)"

だから、

=SUMIFS([★DATA.xlsx]ローデータ!$AG$3:$AG$
必要な、この部分と取得した最終行を連結してやればいいんです。

数式の文字 = "=SUMIFS([★DATA.xlsx]ローデータ!$AG$3:$AG$" & r & _
       ",[★DATA.xlsx]ローデータ!$AH$3:$AH$" & r & _
       ",E$4,[★DATA.xlsx]ローデータ!$C$3:$C$" & y & _
       ",$D6,[★DATA.xlsx]ローデータ!$AK$3:$AK$" & r & ",$B$4)"


Formulaでの相対参照って言うのかな、の変化がどう変わるのか忘れた上未確認だけど。
(2007になってからほとんど触って無いので、っていうかあまり触りたくないって気分。)

因みに
★DATA.xlsx の文字を変数に入れておくと

星ブック名 = "★DATA.xlsx"
Set WB = Workbooks(星ブック名)

で済むし

数式の文字 = "=SUMIFS([" & 星ブック名 & "]ローデータ!$AG$3:$AG$" & r & _
       ",[" & 星ブック名 & "]ローデータ!$AH$3:$AH$" & r & _
       ",E$4,[" & 星ブック名 & "]ローデータ!$C$3:$C$" & y & _
       ",$D6,[" & 星ブック名 & "]ローデータ!$AK$3:$AK$" & r & ",$B$4)"

なんか余計に解りづらくなった気がするけど、ブック名「★DATA.xlsx」が変わった時に、

星ブック名 = "新★DATA.xlsx"

と、変数に入れる値だけ変えれば済むという利点があります。
・ツリー全体表示

【79630】Re:OSのBit数判定
お礼  タロサ  - 18/2/21(水) 15:18 -

引用なし
パスワード
   有難うございました、お陰様で判別出来ました。
・ツリー全体表示

【79629】住所をいい感じに区切る
質問  りった  - 18/2/21(水) 15:12 -

引用なし
パスワード
   1つのセルに記載されいている住所(英語)を、いい感じに区切って4つのセルに出力します。
入力セルの住所は、文節がカンマで区切られています。
(カンマは4つ以上あり得るので、複数の文節を1セルに出力することもあります。)
出力セルの区切りは、カンマの位置です。

「いい感じ」の定義は下記です。(※)
1.区切り方候補1における最大長の出力セルの文字数が
 区切り方候補2における最大長の出力セルの文字数より大きければ
 区切り方2の方がいい感じです。
2.1.で決着つかなかった場合、2番目に長い出力セルの文字数で比較します。

現状のアルゴリズムは、1セル最大35文字で、文節区切りの前倒しです。
(1セル目に入りきらなくなったら、文節単位で区切って2セル目。)

どんなふうに作ればよろしいでしょうか?
なにかアドバイスをお願いします。

※ 場合によっては変更可能なので、他にあればご提案ください。

以下、例です。
入力セル:AAAAAAA CENTRE,BBBBBBBBBBBB AVENUE,CCC STREET,LANCASHIRE,FY5 4QD,UNITED KINGDOM

(現状)
出力セル1:AAAAAAA CENTRE BBBBBBBBBBBB AVENUE
出力セル2:CCC STREET LANCASHIRE FY5 4QD
出力セル3:UNITED KINGDOM
出力セル4:(空欄)

(いい感じ)
出力セル1:AAAAAAA CENTRE
出力セル2:BBBBBBBBBBBB AVENUE
出力セル3:CCC STREET LANCASHIRE
出力セル4:FY5 4QD UNITED KINGDOM
・ツリー全体表示

【79628】関数を使用して他BOOKからの最終行の取得...
質問  nao  - 18/2/21(水) 12:01 -

引用なし
パスワード
   説明が難しいんですが、アクティブBookに対して他Bookからのデータを関数で取得してます。その際にSUMIFSを使用してるんですが、列全部で指定してしまうと時間がかかってしまうためRowsで最終行を取得して関数を入れるやり方がわかりません。

Dim WBK As Variant
  Dim i As Long
  Set WBK = ThisWorkbook
  WBK.Activate

  For i = 3 To 12

   Worksheets(i).Select
  Range("E6:P21").Formula = "=SUMIFS([★DATA.xlsx]ローデータ!$AG$3:$AG$999999,[★DATA.xlsx]ローデータ!$AH$3:$AH$999999,E$4,[★DATA.xlsx]ローデータ!$C$3:$C$999999,$D6,[★DATA.xlsx]ローデータ!$AK$3:$AK$999999,$B$4)"

Formulaを使用しているのがいけないのか、上記のようなことを4度ほど繰り返すので他にいい方法がないものかと試行錯誤しております。

Dim r As Long
  Set WBK = ThisWorkbook
  Set WB = Workbooks("★DATA.xlsx")
  r = WB.Worksheets("ローデータ").Range("B2").End(xlDown).Row
と、最終行は取得できるものの関数の書き方がうまくいきません。
ご教示いただけませんでしょうか。
宜しくお願いします!
・ツリー全体表示

【79627】Re:指定期間でログインしたユーザーを知...
質問  amatsuno  - 18/2/20(火) 16:36 -

引用なし
パスワード
   ▼亀マスター さん:

データ量が多量のため、
変数に格納する方法を試したいと思っています。
(各csvは20000件と40000件です)
 ws_masterが40000件
 ws_daily2が20000件


ただ、配列に格納して実施したいのですが、

格納したい当該の箇所は、取得前と取得後の抽出対象列が異なっています。
どのように並び替えればいいのでしょうか?


  Dim daily_num As Long
  Dim master_num As Long
  
  Dim count_master As Long
  Dim count_daily As Long

  Dim ws_master As Worksheet
  Dim ws_match As Worksheet

  Dim mail_match As String

   Dim ary_cell As Variant ' ←配列予定の変数


  For master_num = 1 To count_master
   
    For daily_num = 1 To count_daily
         mail_match = ws_master.Range("D" & master_num)
       
      If ws_daily2.Range("B" & daily_num).Value = 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


>col1とcol3の値に問題があると思います。
>いずれも値が1になっているので、Forループからすぐに抜けてしまうようです。
>
>    cols1 = .UsedRange.Cells(.UsedRange.Rows.Count, 1).Column
>    cols3 = .UsedRange.Cells(.UsedRange.Rows.Count, 1).Column
>
>これはいずれもColumnがRowの誤りでしょう。
>CellsプロパティでColumnを1に指定しているのですから、そこから得られたセルのColumnを取得すれば1にしかなりません。
>
>それと、これを修正しても問題が残っています。
>ループに入ってからの
>    If ws6.Range("B" & migi).Value = ws1.Range("D" & hida).Value Then
>ですが、migiはmaster(ws1)の行数、hidaはdaily3(ws6)の行数を表しているのですから、ここでは逆でしょう。
>
>同じく、
>    ws3.Range("A" & hida).Value = ws1.Range("B" & hida).Value
>    ws3.Range("B" & hida).Value = ws1.Range("D" & hida).Value
>    ws3.Range("C" & hida).Value = ws1.Range("C" & hida).Value
>    ws3.Range("D" & hida).Value = ws1.Range("A" & hida).Value
>は、いずれも=の右側の式でhidaをmigiに修正する必要があると思われます。
>
>以上で、私が手元で試してみた範囲では動作しました。
>
>
>なお、動作には支障がないのですが、変数名は直した方がいいですね。ws1とかcols1とかhidaとか、何を表しているのかわかりません。私がコードを読む際にも、結構読みにくかったですよ。
>ws1ならsh_masterのような、中身がわかる変数名にするか、いっそのこと変数を使わずにWorksheets("master")だけでもいいのではないでしょうか。
>
>それに、シートの選択方法が、ws1のような変数を使ったり、Worksheet("シート名")になっていたり、ActiveSheetになっていたりで、やはりどのシートを指定しているのかがわかりにくいです。特にActiveSheetは手前のコードを読んでどこのシートがアクティブになっているのかを調べないとわかりませんし、そもそもそのシートをアクティブにする処理が余計です。
>
>あと、サンプル程度のデータ量ならこれでもすぐ終わると思いますが、件数が多くなってくるとセルの読み書きの回数が多くなり、処理に時間がかかるようになりますよ。
>Variant型変数にセル範囲を代入して配列として扱う方法がありますので、余裕があれば勉強してみてはどうでしょうか。
>ht tp://officetanaka.net/excel/vba/speed/s11.htm
・ツリー全体表示

1 / 3701 ページ 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free