[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『色付きセルと月の複数条件で検索』（ニシポン）
すみませんが、分かる方教えて頂きたいです。
色付きセルで納品の行先ごとに分けておりますが、それに月検索を付け、
色付きセルと月検索で件数を抽出したいと思っています。
オートフィルターの機能以外で出来る方法はないでしょうか？
例）
データ 赤 8/31 赤 9/1 赤 9/2
検索結果 赤 8月 1件 赤 9月 2件
＜ 使用 Excel：Excel2010、使用 OS：Windows10 ＞
もっとも、提示されたようなデータの並びだとオートフィルタ使えないでしょうが。
（もこな２） 2018/08/07(火) 08:45
（ニシポン） 2018/08/07(火) 17:29
A B C D
1 赤9/1 赤9/1 青9/2 黄9/2
2 黄9/3 青9/5 青9/6 青9/6
3
4
5
（ニシポン） 2018/08/07(火) 19:30
１）左端の数字とは、どこにあるのですか
２）列は何列目まであるのですか
３）業は何行目まであるのですか
４）色は何種類あるのですか
５）月は何ヶ月分あるのですか
（マナ） 2018/08/07(火) 19:42
1）左端の数字は、1列目の1〜5に当たります。（製造日）
2）A〜Fの6列目までになります。
3）製造日のため、31行になります。
4）今の所、4種類です。
5）多くて2か月分です。
（ニシポン） 2018/08/07(火) 22:06
（マナ） 2018/08/07(火) 22:22
回答ではありませんが
マナさんのご提案をコードにしてみました ＾＾
他のもっとスマートな方法は有るとは思いますが。
情報の状態によってはうまく出来ないかもしれません。。。お勉強の
何かの足しにでも m(__)m
'Worksheets("Sheet1").Range("A1:F31")がデーター範囲として
'日付はシリアル値として ^^;エラー処理無しです。
Option Explicit
Sub d_mk02()
Dim i As Long, j As Long
Dim y As Long
Worksheets("Sheet1").Copy
y = 39
With ActiveSheet
For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
For j = 2 To .Cells(i, Columns.Count).End(xlToLeft).Column
If .Cells(i, j) <> "" And .Cells(i, j) <> " " Then
y = y + 1
.Cells(y, 1) = .Cells(i, 1)
.Cells(y, 2) = CLng(Format(.Cells(i, j), "mm"))
.Cells(y, 3) = .Cells(i, j).Interior.Color
.Cells(y, 3).Interior.Color = .Cells(y, 3)
End If
Next
Next
.Rows("1:38").Delete
.Cells(1, 1) = "製造日"
.Cells(1, 2) = "納入先（色）"
.Cells(1, 3) = "納品日"
.Range("A:C").EntireColumn.AutoFit
End With
End Sub
（隠居じーさん） 2018/08/08(水) 11:16
知識がないもので、上記の式ではどうしてもうまく動いてくれません。
下記の物が実際の物でロット部分が行先別に色分けされています。
A B C D E F G
1 日付 LotNo 納期 LotNo 納期 LotNo 納期
2 7/1
3 7/2 300702-1 7/11 300702-2 7/11 300702-3 7/18
4 7/3 300703-1 7/18 300703-2 7/18
5 7/4 300704-1 7/18 300704-2 7/18 300704-3 7/18
下記の式で止まってしまいます。どうしてか教えて頂きたいです。
.Cells(y, 2) = CLng(Format(.Cells(i, j), "mm"))
（ニシポン） 2018/08/12(日) 10:16
A B C D 1 赤9/1 赤9/1 青9/2 黄9/2 2 黄9/3 青9/5 青9/6 青9/6 3 4 5 （ニシポン） 2018/08/07(火) 19:30の
マナさんの質問にお答えします。
1）左端の数字は、1列目の1〜5に当たります。（製造日） 2）A〜Fの6列目までになります。 3）製造日のため、31行になります。 4）今の所、4種類です。 5）多くて2か月分です。 （ニシポン） 2018/08/07(火) 22:06
を元に推測した情報をもとに組まれていますので。。。 フォーマットが全然違いますので お役には立たないと思います。 原因は 日付から月を数値にしているだけですので。多分日付では ない箇所を参照しているものと思われます。 m(__)m （隠居じーさん） 2018/08/12(日) 10:47
Option Explicit
Sub test()
Dim dic As Object
Dim n As Long
Dim r As Range, c As Range
Dim o As Long
Dim 製造日 As Date, LotNo As String, 納品先 As Long, 納期 As Date
Set dic = CreateObject("scripting.dictionary")
n = 1
dic(n) = Array("製造日", "LotNo", "納品先", "納期")
Set r = Cells(1).CurrentRegion
For Each c In r.Columns(2).Offset(1).SpecialCells(2)
製造日 = c.Offset(, -1).Value
o = 0
Do
With c.Offset(, o)
LotNo = .Value
納品先 = .Interior.ColorIndex
納期 = .Offset(, 1).Value
End With
n = n + 1
dic(n) = Array(製造日, LotNo, 納品先, 納期)
o = o + 2
Loop While c.Offset(, o).Value <> ""
Next
Worksheets.Add.Cells(1).Resize(n, 4).Value = _
Application.Transpose(Application.Transpose(dic.items))
End Sub
（マナ） 2018/08/12(日) 12:09
結果が出るように下記の式を作り、算出しました。
納期がすべて8月の際には算出出来たのですが、7月を含む際には結果が少数点になってしまいました。
=SUMPRODUCT((CountColor(C$2:C$32,B38)+NOW()*0)*(MONTH(C$2:C$32)=8))/10
B38には色が入っています。
算出させようとした関数に間違いがあったのでしょうか？
（ニシポン） 2018/08/14(火) 18:27
わたしのマクロとその式はなにか関係あるのでしょうか？
（マナ） 2018/08/14(火) 18:50
「CountColor」なるものをどうにかした方が早いんじゃないですかねぇ・・
学校内を検索するとそれらしきコードがありました。
そいつを改造してみました。数式も少し変わります。
＞=SUMPRODUCT((CountColor(C$2:C$32,B38)+NOW()*0)*(MONTH(C$2:C$32)=8))/10 ~~↑~~~ ~↑~ 不要 何故10で割るのか不明
=SUMPRODUCT((CountColor(C$2:C$32,B38,True)*(MONTH(C$2:C$32)=8))/10 ~↑~ 留意；今までと同じ機能で使いたい時はここには何も書かないでください
Public Function CountColor(ByVal Target As Range, refCell As Range, Optional Ary As Boolean = False)
Dim RW As Long, CL As Long
Dim Ret() As Long
ReDim Ret(1 To Target.Rows.Count, 1 To Target.Columns.Count)
Application.Volatile
For RW = 1 To UBound(Ret)
For CL = 1 To UBound(Ret, 2)
If Target.Cells(RW, CL).Interior.Color = refCell.Interior.Color Then
CountColor = CountColor + 1
Ret(RW, CL) = 1
End If
Next CL
Next RW
If Ary Then
CountColor = Ret
End If
End Function
（半平太） 2018/08/14(火) 21:04
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.