[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『訪問回数と最終訪問日のレコードの表示』（k-pon）
訪問日 社名 従業員規模 状況 備考 2014/9/26 A社 20～50人 終了 成約 2014/11/5 B社 20～50人 終了 見込みなし 2014/3/1 C社 10～19人 継続 見込みあり 2015/3/6 C社 10～19人 継続 商談中 2015/3/8 D社 10～19人 継続 不明 2015/3/10 D社 10～19人 継続 見込みあり 2016/3/21 C社 10～19人 終了 成約
上のような入力（実際には数千件あります）に対して、
年月を指定することで、訪問回数と最終訪問日のレコードを表示する方法をご教示ください。
例えば、上の例で、2015年3月を指定すると、
訪問日 社名 状況 備考 訪問回数 2015/3/10 D社 継続 見込みあり 2 2015/3/21 C社 終了 成約 3
と別シートに表示できるようにしたいと考えております。同時に不要な列（今回の例では「従業員規模」を非表示にしたいです。）
何卒、宜しくお願い申し上げます。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
＞2016/3/21 C社 10～19人 終了 成約
は、2015/2/21の間違いで
＞2015/3/21 C社 終了 成約 3
は、訪問回数が２の間違いですか？
（マナ） 2016/04/27(水) 21:42
＞2016/3/21 C社 10～19人 終了 成約
は、2015/3/21の間違いですか
（マナ） 2016/04/27(水) 21:54
こんばんわ。
マナさんから質問があった事で、仮に表記が間違いでは無く3年越しの案件だとして、
＞2014/3/1 C社
＞2015/3/6 C社
＞2016/3/21 C社
＞年月を指定する
指定した年月の分だけを計算対象にすると、例えば2015年3月を指定すると、1件しか該当しなくなりますが良いんですか？
もしくは指定した年月までの時点の実績を知りたいと言う事でしょうか？ C社の場合の例、 2014年3月を指定すると、継続 見込みあり 1回 2015年3月を指定すると、継続 商談中 2回 2016年3月を指定すると、終了 成約 3回 上記のようにしたいと言う事ですか？
（sy） 2016/04/27(水) 23:58
ありがとうございます。また、記載ミスがあり申し訳ございません。
sy様ご指摘の通り、指定した年月までの時点の実績の会社別一覧が知りたいのです。
最初はマナ様ご指摘の設定で考えていたので、自分で整理しきれず矛盾が発生してしまいました。
よろしくお願い申し上げます。
（k-pon） 2016/04/28(木) 07:56
たとえば１つの処理例です。
１．からっぽのSheet2の A1～D1 に 訪問日、社名、状況、備考 と、抽出したい列のタイトルをいれます。 ２．H1 にも 訪問日 といれます。 ３．2015/3 までなら H2 に <2015/4/1 といれます。 ４．この状態でフィルター詳細設定。 １）リスト範囲(L) を Sheet1 の タイトル行含めた 表全体（A1:E8 等） この領域は A1 を選んで Ctrl/Shift/End でも取得できます。 ２）検索条件範囲を SHeet2 の H1:H2 ３）選択した範囲(O) を選び 抽出範囲(T) を Sheet2 の A1:D1 ４）ＯＫボタン ５．抽出されたものに対し、A列降順に並び替え ６．再びフィルター詳細設定 １）リスト範囲(L) を B列 ２）重複するレコードを無視する(R) にチェック ３）ＯＫボタン ７）E2 : =COUNTIF(B:B,B2) これを下にフィルコピー
（β） 2016/04/28(木) 08:49
Sub test()
Dim d, myDate As Date
Dim dicA As Object, dicB As Object
Dim v, w
Dim i As Long
Dim k As String
d = Format(DateAdd("m", -1, Date), "yyyy/m")
d = Application.InputBox("年月指定(YYYY/M)", , d, Type:=2)
If VarType(d) = vbBoolean Then Exit Sub
If IsDate(d) Then
myDate = WorksheetFunction.EoMonth(CDate(d), 0)
Else
MsgBox "入力は年月 YYYY/M"
Exit Sub
End If
v = Worksheets("sheet1").Range("a1").CurrentRegion.Value
Set dicA = CreateObject("scripting.dictionary")
Set dicB = CreateObject("scripting.dictionary")
dicA("見出し") = Array(v(1, 1), v(1, 2), v(1, 4), v(1, 5), "訪問回数")
For i = 2 To UBound(v)
If v(i, 1) > myDate Then Exit For
k = v(i, 2)
dicB(k) = dicB(k) + 1
If Format(v(i, 1), "yyyy/m") = d Then
dicA(d & k) = Array(v(i, 1), k, v(i, 4), v(i, 5), dicB(k))
End If
Next
w = Application.Index(dicA.items, 0, 0)
If dicA.Count = 1 Then MsgBox "該当なし": Exit Sub
Worksheets.Add.Range("a1").Resize(UBound(w, 1), UBound(w, 2)).Value = w
End Sub
（マナ） 2016/04/28(木) 19:40
大変失礼いたしました。
訪問日 社名 従業員規模 状況 備考 2014/9/26 A社 20～50人 終了 成約 2014/11/5 B社 20～50人 終了 見込みなし 2014/3/1 C社 10～19人 継続 見込みあり 2015/3/6 C社 10～19人 継続 商談中 2015/3/8 D社 10～19人 継続 不明 2015/3/10 D社 10～19人 継続 見込みあり 2016/3/21 C社 10～19人 終了 成約
に対して、2015年3月を指定すると、
訪問日 社名 状況 備考 訪問回数 2015/3/6 C社 継続 商談中 2 ←2014/3/1と2015/3/6の2カウント 2015/3/10 D社 継続 見込みあり 2 ←2015/3/8と2015/3/10の2カウント
を考えています。
β様
ありがとうございます。
手作業では何とかうまくいきました。
ただ、
６．再びフィルター詳細設定
１）リスト範囲(L) を B列
２）重複するレコードを無視する(R) にチェック
３）ＯＫボタン
の部分かと思いますが、マクロを記録して実行しようとすると、
Columns("B:B").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
の部分でタイトル以外の列が全て見えなくなってしまいました。
Range("B1:B276").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
でも大体同じようです。
左端の列番号の数字が青くなっているのですが、何か関係ありますでしょうか・・・・
何度もお手数をおかけし申し訳ございません。
宜しくお願いします。
（k-pon） 2016/04/28(木) 20:03
作業手順の再確認と、仮にそれをマクロ化したらどうなるか、もう１つ、最初からＶＢＡで書く例を 出来上がり次第アップしたいと思いますが、その前に、マナさんからの依頼で、そちらがアップされたサンプル。
>>2015年3月を指定すると
ですが、この結果のサンプルが、どうしても理解できません。
過去から2015年3月までなら 2014/9/26 A社 も対象になるはずです。
じゃぁ、この意味は 2015年3月だけなのか？ そうすると、2014/3/1 の D社 も対象外のはず？？？
2015/3 の指定に対して、何が対象なのか、もう少し明確にしていただけませんか？
もしかしたら 2015/3 に実績のあった会社だけに対して、過去からすべてのデータ抽出？
その条件によっては、提示した手順そのものが使い物にならないかもしれませんので。
（β） 2016/04/28(木) 20:21
何度もお手数をおかけし申し訳ございません。ありがとうございます。
訪問日 社名 従業員規模 状況 備考
(1) 2014/9/26 A社 20～50人 終了 成約 (2)2014/11/5 B社 20～50人 終了 見込みなし (3)2014/3/1 C社 10～19人 継続 見込みあり (4)2015/3/6 C社 10～19人 継続 商談中 (5)2015/3/8 D社 10～19人 継続 不明 (6)2015/3/10 D社 10～19人 継続 見込みあり (7)2016/3/21 C社 10～19人 終了 成約
に対して、2015年3月を指定すると、
訪問日 社名 状況 備考 訪問回数
(4)2015/3/6 C社 継続 商談中 2 ←2014/3/1と2015/3/6の2カウント (6)2015/3/10 D社 継続 見込みあり 2 ←2015/3/8と2015/3/10の2カウント
じゃぁ、この意味は 2015年3月だけなのか？
そうすると、2014/3/1 の D社 も対象外のはず？？？ 2015/3 の指定に対して、何が対象なのか、もう少し明確にしていただけませんか？
説明が下手くそでご迷惑をおかけし申し訳ございません。
もしかしたら 2015/3 に実績のあった会社だけに対して、過去からすべてのデータ抽出？ この認識で正しいです。
抽出条件は、2015/3月指定の例ですと、
・2015/3月に訪問実績のある会社
・2015/3/31までの累計訪問件数（この訪問件数は、過去の全てからのカウントです。）
・同一会社が複数ヒットする場合は、一番最後のエントリーを持ってくる。
になります。
例に（）で行番号をつけてみました。
(1)は訪問日は2015/3以前ですが、2015年3月にA社の訪問がないので表示しません
(2)も同様に、訪問日は2015/3以前ですが、2015年3月にB社の訪問がないので表示しません
(3)は訪問日は2015年3月ですが、同じ月にもっと新しいC社のエントリー(4)があるので表示しません。
(4)2015/3に実績のあるC社のレコードの中で、2015/3時点でもっとも新しいエントリーであるため、表示します。この際、2015/3以前の全てのレコードからC社の訪問回数を数えます
(5)訪問日は2015年3月ですが、同じ月にもっと新しいD社のエントリー(6)があるので表示しません。
(6) (4)と同じ理由により表示します。
(7) 期間外（2015/3/31より後）のため、表示しません。訪問回数にもカウントしません。
分かりづらくて大変申し訳ございません。
宜しくお願い申し上げます。
（k-pon） 2016/04/28(木) 22:41
こんばんわ。
こんな感じでしょうか？ 仮にデータシートをSheet1、結果を表示するシートをSheet2として
Sheet2
|[G] |[H]|[I]|[J] |[K]
[1]|年 |月 | |訪問日 |訪問日
[2]|2015| 3| |>=42064|<=42094
J2=">="&DATE(G2,H2,1) K2="<="&DATE(G2,H2+1,1)-1 と予め数式を入れて置き、
G2に年、H2に月を入力して年月を指定して、 下記コードを実行して下さい。 直接セル操作ばかりなので、遅かったら申し訳ありません。
Sub test()
Dim sh1 As Worksheet, sh2 As Worksheet
'画面描画停止
Application.ScreenUpdating = False
'シートを変数にセット
Set sh1 = Sheets("Sheet1") 'データシート
Set sh2 = Sheets("Sheet2") '結果シート
'データシートに作業列を追加
sh1.Range("G:K").Insert
'指定期間の条件でデータを抽出
sh1.Range("A1").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=sh2.Range("J1:K2"), _
CopyToRange:=sh1.Range("G1:K1"), _
Unique:=True
'不要列を削除
sh1.Range("I:I").Delete
'日付降順で並べ替え
sh1.Sort.SortFields.Clear
sh1.Sort.SortFields.Add Key:=sh1.Range("G2"), Order:=xlDescending
With sh1.Sort
.SetRange sh1.Range("G:J")
.Header = xlYes
.Apply
End With
'重複を削除
sh1.Range("G1").CurrentRegion.RemoveDuplicates Columns:=2, Header:=xlYes
'結果シートを初期化
sh2.Range("A:E").ClearContents
'データを結果シートに貼付
sh1.Range("G1").CurrentRegion.Copy sh2.Range("A1")
'訪問回数をセット
sh2.Range("E1").Value = "訪問回数"
sh2.Range("E2:E" & sh2.Range("A" & Rows.Count).End(xlUp).Row).Formula _
= "=COUNTIFS(Sheet1!$A$2:$A$10000,$K$2,Sheet1!$B$2:$B$10000,B2)"
'作業列を削除
sh1.Range("G:J").Delete
'画面描画再開
Application.ScreenUpdating = True
End Sub
（sy） 2016/04/29(金) 00:27
ありがとうございます。
頂いたコードを試してみましたところ、
訪問日 社名 状況 備考 訪問回数 月 年 月 訪問日 訪問日 2015/3/10 D社 継続 見込みあり 2 3 2015 3 >=42064 <=42094 2015/3/6 C社 継続 商談中 2
となり、求めていた動作をしてくれました！
EXCELではマクロ使うのがほぼ初めてで、お手数をおかけしました。
ありがとうございました。
また、マナ様から頂いたコードで、2015/3を指定して実行しましたところ、
訪問日 社名 状況 備考 訪問回数 2015/3/6 C社 継続 商談中 2 2015/3/10 D社 継続 見込みあり 2
と、やはり求めていた通りの結果が出ました。ありがとうございました。
大変お手数ですが、もうひとつ教えてください。
簡略化した例でシミュレーションしていましたが、実際のデータは、
訪問日がB列、企業名がI列にあります。
この場合は、お二人から今回頂いたコードのどこを変更すればよいのでしょうか・・・
1時間ぐらい格闘していたのですが、うまくいきませんでした。
何卒、宜しくお願い申しあげます。
（k-pon） 2016/04/29(金) 07:34
おはようございます。
質問する時は、後からご自身で修正できるだけのスキルがあるなら、簡略化しても良いですが、 提示するのがまずかったら名称だけ変更して、配置(列数や行数、並び方の順番、どの列に目的の項目があるか)などは、 実際に合わせて正確に提示するようにして下さい。 回答者に2度手間、3度手間させる事になるし、解決にも時間がかかります。
実際のデータシートは何列あるんですか？ 結果シートの項目は例と変わりませんか？ 後、結果シートに表示させたい項目がどの列にあるかを、全ての項目分提示して下さい。
（sy） 2016/04/29(金) 07:56
おっしゃる通りです。
何度もご迷惑をかけて申し訳ございません。
元データは
A列：SeqNo B列：年度 C列：受付区分 D列：訪問日 E列：訪問年 F列：訪問月 G列：初回日 H列：回数 I列：相談受付日 J列：終了日 K列：担当1 L列：担当2 I列：担当2 M列：事業区分 N列：上程日 O列：企業No P列：企業名 Q列：企業カナ R列：業種 S列：業態 T列：従業員別内訳 U列：資本金別内訳 V列：売上高別内訳 W列：入口 X列：出口 Y列：相談区分?1 Z列：相談区分2 AA列：開始年度 AB列：終了年度 AC列：情報入手方法 AD列：情報入手方法（その他内訳） AE列：1：販路 AF列：2：生産性
AG列：3:不採算 AH列：4:財務構造 AI列：5:人事 AJ列：6:提携 AK列：7:転換\ AL列：8:整理 AM列：9:紹介 AN列10:他紹介AO列：11:海外
となっております。（P列：企業名、D列：訪問日）
残したい列は、
D列：訪問日 G列：初回日 H列：回数 K列：担当1 L列：担当2 O列：企業No P列：企業名 R列：業種 S列：業態 T列：従業員別内訳 U列：資本金別内訳 V列：売上高別内訳 W列：入口 X列：出口 Y列：相談区分1 Z列：相談区分2 AC列：情報入手方法 AE列：1：販路 AF列：2：生産性 AG列：3:不採算 AH列：4:財務構造 AI列：5:人事 AJ列：6:提携 AK列：7:転換 AL列：8:整理 AM列：9:紹介 AN列10:他紹介 AO列：11:海外
です。
むやみに増やし過ぎてしまったため、列数が多く、逆に分かりにくくなってしまうかと素人判断したのが良くなかったようです。
大変失礼いたしました。申し訳ございません。
何卒、宜しくお願い申し上げます。
（k-pon） 2016/04/29(金) 08:30
結果シートの列数が多いので、抽出条件の入力のし易さを考えて、少しレイアウトを変更してみました。 レイアウトが具合悪ければ、お知らせ下さい。
結果のSheet2、A2に年、B2に月、4行目に見出し、5行目以降に結果表示
D2=">="&DATE(A2,B2,1) E2="<="&DATE(A2,B2+1,1)-1
Sheet2
|[A] |[B] |[C] |[D] |[E] |[F] |[G] |[H]
[1]|年 |月 | |訪問日 |訪問日| | |
[2]| 2016| 3| |>=42430|<42461| | |
[3]| | | | | | | |
[4]|訪問日 |初回日|回数|担当1 |担当2 |企業No|企業名|業種
[5]|2016/3/21| | | | | |C社 |
コードを下記に変更して下さい。
Sub test()
Dim sh1 As Worksheet, sh2 As Worksheet
'画面描画停止
Application.ScreenUpdating = False
'シートを変数にセット
Set sh1 = Sheets("Sheet1") 'データシート
Set sh2 = Sheets("Sheet2") '結果シート
'データシートに作業列を追加
sh1.Range("AQ:CE").Insert
'指定期間の条件でデータを抽出
sh1.Range("A1").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=sh2.Range("D1:E2"), _
CopyToRange:=sh1.Range("AQ1:CE1"), _
Unique:=True
'不要列を削除
sh1.Range("AQ:AS,AU:AV,AY:AZ,BC:BD,BG:BG,BQ:BR,BT:BT").Delete
'日付降順で並べ替え
sh1.Sort.SortFields.Clear
sh1.Sort.SortFields.Add Key:=sh1.Range("AQ2"), Order:=xlDescending
With sh1.Sort
.SetRange sh1.Range("AQ:BR")
.Header = xlYes
.Apply
End With
'重複を削除
sh1.Range("AQ1").CurrentRegion.RemoveDuplicates Columns:=7, Header:=xlYes
'結果シートを初期化
sh2.Range("A5:AC" & Rows.Count).ClearContents
'データを結果シートに貼付
sh1.Range("AQ1").CurrentRegion.Copy sh2.Range("A4")
'訪問回数をセット
sh2.Range("AC4").Value = "訪問回数"
sh2.Range("AC5:AC" & sh2.Range("A" & Rows.Count).End(xlUp).Row).Formula _
= "=COUNTIFS(Sheet1!$D$2:$D$10000,$E$2,Sheet1!$P$2:$P$10000,G5)"
'作業列を削除
sh1.Range("AQ:BR").Delete
'画面描画再開
Application.ScreenUpdating = True
End Sub
すいません、結果シートの初期化の範囲が間違ってたので修正します。
（sy） 2016/04/29(金) 09:25
（マナ） 2016/04/29(金) 11:07
Sub test2()
Dim d, myDate As Date
Dim dic As Object
Dim myCol
Dim v, w
Dim i As Long
Dim k As String
Dim myRow As String
d = Format(DateAdd("m", -1, Date), "yyyy/m")
d = Application.InputBox("年月指定(YYYY/M)", , d, Type:=2)
If VarType(d) = vbBoolean Then Exit Sub
If IsDate(d) Then
myDate = WorksheetFunction.EoMonth(CDate(d), 0)
Else
MsgBox "入力は年月 YYYY/M"
Exit Sub
End If
With Worksheets("sheet1").Range("a1").CurrentRegion
With .Offset(, .Columns.Count).Columns(1)
.Formula = "=countif(P$1:P1,P1)" '★P列は企業名
.Cells(1).Value = "訪問回数"
End With
v = .Resize(, .Columns.Count + 1).Value
.Columns(.Columns.Count + 1).Clear
'★抽出列を指定
myCol = Array(4, 7, 8, 11, 12, 15.16, 18, 19, 20, _
'' 21, 22, 23, 24, 25, 26, 29, 31, _
'' 32, 33, 34, 35, 36, 37, 38, _
'' 30, 40, 41, .Columns.Count + 1)
End With
Set dic = CreateObject("scripting.dictionary")
For i = UBound(v) To 2 Step -1
If Format(v(i, Columns("D").Column), "yyyy/m") = d Then '★D列は訪問日
k = v(i, Columns("P").Column) '★P列は企業名
If Not dic.exists(k) Then
dic(k) = True
myRow = i & " " & myRow
End If
End If
Next
w = Application.Index(v, Application.Transpose(Split(Trim("1 " & myRow), " ")), myCol)
If dic.Count = 0 Then MsgBox "該当なし": Exit Sub
Worksheets.Add.Range("a1").Resize(UBound(w, 1), UBound(w, 2)).Value = w
End Sub
（マナ） 2016/04/29(金) 11:16
何度もお手薄をおかけし申し訳ございません。
また、ここまでお付き合い頂きありがとうございます。
色々勘違いや理解不足の部分がありましたので、ご返信遅くなりましたが、
お陰さまで何とか成功しました。
また、質問の作法も分からず大変ご迷惑をおかけしました。
ありがとうございました！
マナ様
ありがとうございます！
頂いたコードを試してみたのですが、
myCol = Array(4, 7, 8, 11, 12, 15.16, 18, 19, 20, _
'' 21, 22, 23, 24, 25, 26, 29, 31, _
'' 32, 33, 34, 35, 36, 37, 38, _
'' 30, 40, 41, .Columns.Count + 1)
だと構文エラーになり、
コメントアウトをはずして
myCol = Array(4, 7, 8, 11, 12, 15.16, 18, 19, 20, _
21, 22, 23, 24, 25, 26, 29, 31, _
32, 33, 34, 35, 36, 37, 38, _
30, 40, 41, .Columns.Count + 1)
でやると、
w = Application.Index(v, Application.Transpose(Split(Trim("1 " & myRow), " ")), myCol)
が黄色くなり、「型が一致しません」のエラーがでてしまいました。
私の理解不足で大変ご迷惑をおかけしております。
何卒、宜しくお願い申しあげます。
（k-pon） 2016/04/29(金) 11:46
ごめんさい。対応はそれでOKです。
行数、列数とか条件変えて動作確認したときの名残りです。
＞「型が一致しません」のエラー
こちらについても、ごめんなさいです。
再現できなくて、原因がわかりません。
（マナ） 2016/04/29(金) 13:02
かしこまりました。
勉強がてら色々試してみます。自宅(2007)と職場(2010)でEXCELのバージョンが違うのでそっちかもしれません
色々教えて下さりありがとうございます。
心より感謝申し上げます。m(__)m
（k-pon） 2016/04/29(金) 13:15
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.