Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
142 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
【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
・ツリー全体表示
【79626】Re:OSのBit数判定
発言  Jaka  - 18/2/20(火) 0:05 -
引用なし
パスワード
   Application.OperatingSystem
だと、64ビットでうまく動かないらしい。
ここ参考にしては。

ht tps://www.ka-net.org/blog/?p=3779
・ツリー全体表示
【79625】Re:OSのBit数判定
発言  Jaka  - 18/2/19(月) 16:18 -
引用なし
パスワード
   MsgBox Application.OperatingSystem

64ビットで、調べたこと無いけど。
・ツリー全体表示
【79624】OSのBit数判定
質問  タロサ  - 18/2/19(月) 13:33 -
引用なし
パスワード
   OSが32Bitか64Bitかを判定したいのですが、
分かる方が居ましたらご教授下さい。
・ツリー全体表示
【79623】Re:VBAで、複数の条件を出力させたい
発言  γ  - 18/2/16(金) 21:16 -
引用なし
パスワード
   解決されたようですが、こんな方法が普通かもしれませんね。

　　For i = 1 To reccount
　　　　If Cells(i, 3).Value = False Or _
　　　　　　(Cells(i, 3).Value = True _
　　　　　　 And Cells(i, 4).Value >= DATE_ST _
　　　　　　 And Cells(i, 4).Value <= DATE_ED) Then
　　　　　　Rows(i).Copy newsheets.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
　　　　End If
　　Next i
（Cells(i, 3).Valueは False か True のいずれかと限定できないものとしました）


なお、
Dim i, reccount As Long
は不可です（ i は Variant型です）。
Dim i As Long, reccount As Long
とします。
・ツリー全体表示
【79622】Re:VBAで、複数の条件を出力させたい
発言  amatsuno  - 18/2/16(金) 16:50 -
引用なし
パスワード
   すいません。

自己解決しました。

手順は以下で対応しました

1.COL-3がFALSEのみを抽出する
（ここで、NAME1〜3が抽出される）

2.COL-4が2018/1/1〜2018/2/1のみを抽出する
（ここで、NAME3・NAME6が抽出される）

3.重複削除を行う
（ここで、NAME3が消える）
・ツリー全体表示
【79621】VBAで、複数の条件を出力させたい
質問  amatsuno  - 18/2/16(金) 13:37 -
引用なし
パスワード
   VBAのコードで、複数のセルの入力条件を持つレコードを出力させたいと思っています

以下のcsvを読み込み、

指定条件のレコードを別セルに抽出したいと思っています

抽出条件は以下の通りです。
（以下1.2.を両方同時に出力します）

・文字列「COL-3がFALSE」のものは抽出する
・文字列「COL-3がTRUE」、かつ「COL-4が2018/1/1〜2018/2/1」のものは抽出する」


具体的には、
以下のCSVより、
NAME1
NAME2
NAME3
NAME6
を出したいと思っています。

ORG.csv
COL-1,COL-2,COL-3,COL-4
NAME1,11,FALSE,
NAME2,22,FALSE,2017/12/1
NAME3,33,FALSE,2018/1/29
NAME4,44,TRUE,
NAME5,55,TRUE,2017/12/1
NAME6,66,TRUE,2018/1/29

csvなので、各カラムは文字列です

COL-4の出力条件については、

DATE_ST = InputBox("抽出開始日")　←2018/1/1を入れます
DATE_ED = InputBox("抽出終了日")　←2018/2/1を入れます

で取得しております


Dim i, reccount As Long
reccount= Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To reccount
If Cells(i, 3) = False Then
Rows(i).Copy newshhets.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next i

とFALSE条件側（1.）のみは書いたのですが、
TRUE側の条件（2.）を追加して記載する場合、どのように記載すればよいのでしょうか？
（COL-3が「TRUE」で、期間が「DATE_ST〜DATE_ED」です）

お分かりになられる方、申し訳ございませんが、よろしくお願いいたします
・ツリー全体表示
【79620】Re:指定期間でログインしたユーザーを知...
お礼  amatsuno  - 18/2/15(木) 13:36 -
引用なし
パスワード
   ありがとうございます。

上記の方法で達成できました。

変数名は修正いたします。

件数については、
おそらくmaster側が10000件程度で、
daily側が6000件程度になりそうなので、
考慮の価値がありそうです
・ツリー全体表示
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
142 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free