多数の品名があり、それぞれ複数のロットのデータがあります。
例えば、
A列 B列 C列
品名A ロットNo.123 データ0.1
品名B ロットNo.235 データ0.5
品名C ロットNo.567 データ3.1
品名A ロットNo.125 データ0.2
品名D ロットNo.425 データ1.2
: : :
と言う感じで、品名は1000以上、全ロット数は30000ほどあります。
ここでロット数が4ロット以上の品名だけを抽出してデータ解析をしたいのですが、うまい方法はあるでしょうか?
一応、D列の一行目に
=countif($A$1:$A$30000,A1)
と入力後、オートフィルで全てコピーしてやれば後はオートフィルターで4以上を指定してやればよいのですが、この数式をオートフィルでコピーする際に非常に時間がかかります(20分くらい)。
もっと簡単にやれる方法があれば教えて頂けると助かります。
No.1ベストアンサー
- 回答日時:
データの並べ替えを行っても問題がなければ下記の方法で少しは早くなると思います(COUNTIFの実行回数が減るはずなので・・・)。
・品名順に並べ替える
・D2に=IF(A2=A1,D1,COUNTIF($A$2:$A$30000,A2))
・式をD3~D30000までコピーする
・オートフィルタでD列が4以上のフィルタをかける
早速やってみました。
少しどころか、非常に早く処理が可能でした。
一分もかかりません。
COUNTIFの実行回数を減らすのが有効なのですね。
ありがとうございました!
No.3
- 回答日時:
こんばんは。
十分に検証を重ねてはいますが、出来上がりは、あまり芳しい状態ではありませんでした。内容的には、簡単ですが、いかに速くする、ということを目的にして作ったのですが、残念ながら、せいぜい6分を切る程度でした。問題になったのは、Excelのデータベース演算が標準で、ワイルドカードになっていること、CountIf を使うと、ひじょうに遅くなるということでした。この処理に手間が掛かりました。
途中で、これは、データベースのグループ化で抽出したほうが速いと気が付きました。
出力値は、E列から、3列を使いますが、K列にクライテリアを置くようになっています。
テンポリー出力したものは、最後に削除しています。
必ず、<標準モジュール>に貼り付けしてくださるようにお願いします。
3万件で、6分というところが目処です。あまり長い場合は、どこかでトラブルが発生しているかもしれません。予想のつかないトラブルがあるかもしれません。
ところどころで、画面を更新させるようにはしています。
今回、途中で止めるオプションはつけてありませんが、Ctrl+Break で止まります。しかし、オブジェクトを抱え込んだままですので、できればそのまま使わずに、一旦、終了させたほうが安全です。
'<標準モジュール>
Option Explicit
Sub PickupCount()
Dim rng As Range
Dim a(), ar()
Dim rtn As Long, buf As Long
Dim i As Long
Dim rnum As Variant, rngValue As Variant
Dim CriteriaRng As Range
'設定
Const PickUp As Integer = 4 'カウント数の下限
Range("D1").ClearContents
Range("E1:F1").CurrentRegion.ClearContents
Set rng = Range("A1", Range("A65536").End(xlUp).Offset(, 2))
'AdvancedFilterの前の条件をクリア
Call DbNamesDelete
Application.ScreenUpdating = False
'並べ替え
rng.Sort Key1:=Range("A1"), _
Order1:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
'抽出1
rng.Resize(, 1).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("E1"), _
Unique:=True
Application.ScreenUpdating = True
Application.ScreenUpdating = False
'Pickupのカウント(以上)の抽出
With Range("E1", Range("E65536").End(xlUp))
rngValue = Range("E1", Range("E65536").End(xlUp)).Value
'Countifの代用
buf = 1
For i = LBound(rngValue, 1) + 1 To UBound(rngValue, 1)
rtn = Application.Match(rngValue(i, 1), rng.Resize(, 1), 1)
.Cells(i, 1).Offset(, 1).Value = rtn - buf
buf = rtn
Next i
'クライテリアの消去
Call DbNamesDelete
Range("E1:F1").Value = Array(Range("A1").Value, "QTY")
Range("H1:H2").Value = Application.Transpose(Array("QTY", ">=" & PickUp))
If Range("E1").CurrentRegion.Rows.Count = 1 Then GoTo LineQuit
.Resize(, 2).AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("H1:H2"), _
Unique:=False
On Error Resume Next
.SpecialCells(xlCellTypeVisible).Copy Range("K1")
On Error GoTo 0
ActiveSheet.ShowAllData
Range("E1").CurrentRegion.ClearContents
Range("H1:H2").ClearContents
End With
Application.ScreenUpdating = True
Application.ScreenUpdating = False
'クライテリアの作成 '
Range("K2", Range("K1").End(xlDown)).Offset(, 1).Formula = "=""<>""&RC[-1]&""?"""
Range("K2", Range("K1").End(xlDown)).Offset(, 1).Value = _
Range("K2", Range("K1").End(xlDown)).Offset(, 1).Value
Set CriteriaRng = Range("K1", Range("K1").End(xlDown).Offset(, 1))
Range("K1").Offset(, 1).Value = Range("K1").Value
Application.ScreenUpdating = True
Application.ScreenUpdating = False
'抽出2
Call DbNamesDelete
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=CriteriaRng, _
CopyToRange:=Range("E1").Resize(, 3), _
Unique:=False
LineQuit:
CriteriaRng.ClearContents
Application.ScreenUpdating = True
Call DbNamesDelete
Set rng = Nothing: Set CriteriaRng = Nothing
End Sub
Sub DbNamesDelete()
Dim nm As Name
'データベース関数の予約語を削除
For Each nm In ThisWorkbook.Names
If nm.Name Like "*[DatabaseCriteriaExtract]*" Then nm.Delete
Next
End Sub
う~、色々とありがとうございます!
けれど申し訳ありませんが、よく分かりません。
また1の回答の方の方法で、何とかなるようです。
ご面倒おかけしました!
No.2
- 回答日時:
VBAで作ってみました。
>品名は1000以上、全ロット数は30000ほどあります。
ただ、1つ確認ですが、
>4ロット以上の品名だけを
品名だけでよいのですか?
それが違うと、無駄になるので、確認してから、アップロードします。
それと、できれば、フィールド行が1つほしいところです。
(つまり、1行目を、A1:品名 B1:ロットNo. C1:データ)
としていただきたいこと。そうしないと、数の計算を間違えることがあります。
フィルターオプション(AdvancedFilter)を使う理由からです。
なお、確認のために、数えた数を、品名の隣に出します。
例:
E列 F列
品名 数
a 40
b 25
計測時間は、私の古いパソコンで、品目1,000件、1つずつ調べて、30,000個のデータを、出力するのに、約2分20秒程度かかります。
この回答への補足
お世話様です。
>品名だけでよいのですか?
誤解しやすい表現ですみませんでした。
品名だけであればピボットで簡単にできますね。
4ロット以上ある品名と、個々のロットのNo.とデータを抽出するのが目的です。逆に言うと、ロット数が3ロット以下の品名のデータを除外したいのです。
ですので、はじめの質問で記載した方法で実行すれば可能なのですが、それの処理速度を改善したいと考えています。
>それと、できれば、フィールド行が1つほしいところです。
につきましては、問題ありません。実際にはフィールド行使用しています。
よろしくお願いします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- SQL Server これをSQL文で出来るでしょうか? 1 2023/03/26 02:16
- 統計学 確率統計:正規分布している実力のロットから部品を2つ抜き取って製品化する場合、製品の実力は良くなる? 5 2023/05/24 00:29
- Visual Basic(VBA) VBAで、1つのエクセルで、2つのシートからもう1つのシートに条件のある転記コードを教えてください。 1 2023/03/16 18:07
- Excel(エクセル) EXCEL 関数を教えてください。(A列の同じ値が複数ある場合vlookupで出来ますか) 4 2022/12/07 20:54
- その他(Microsoft Office) Excelで該当しない項目(#N/Aの商品名)を簡単に表示・抽出させる方法についてです 1 2022/08/25 22:12
- Excel(エクセル) VBAで同フォルダ内の別ブックを開かず参照して条件の一致する行の指定セルを抽出するには? 1 2022/07/21 19:29
- Visual Basic(VBA) 【VBA】複数行あるカンマ区切りのデータを全て縦に一列に並べたい 5 2022/04/13 17:03
- Visual Basic(VBA) 改行ごとに行を追加し、数量を分割 4 2023/07/11 16:39
- FX・外国為替取引 FXで勝つ方法 1 2023/06/15 18:50
- Excel(エクセル) Excelマクロ 差分抽出の方法が知りたいです。 2 2023/03/07 13:25
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
パワポで曲がった両矢印の簡単...
-
パワーポイントの表
-
パワーポイント「スライドショ...
-
パワーポイント2019 図の透...
-
PowerPointでスライドマスタの...
-
パワーポイントをプロンプター...
-
音声マークを一括非表示にしたい。
-
PowerPointVBAでスライドマスタ...
-
PowerPointで、作成されたファ...
-
パワーポイントで説明しながら...
-
パワーポイントのアニメーショ...
-
パワポ 矢印について
-
PowerPointで曲線矢印を描きた...
-
office2019プロダクトキー紛失
-
パワーポイントMacBookにて、 ...
-
PowerPointのスライドショーに...
-
エクセルのマクロについて教え...
-
パワーポイント 印刷をクリック...
-
ExcelのグラフをPowerPointに貼...
-
officeのプロダクトキーを紛失
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
パワポで曲がった両矢印の簡単...
-
音声マークを一括非表示にしたい。
-
パワーポイント「スライドショ...
-
パワーポイントの表
-
PowerPointでスライドマスタの...
-
エクセル・パワーポイントなど...
-
PowerPointVBAでスライドマスタ...
-
PowerPointのアニメーションで...
-
PowerPointで、作成されたファ...
-
エクセルでA3の大きさに資料...
-
ExcelのグラフをPowerPointに貼...
-
パワーポイントで資料を作る時 ...
-
パワーポイントのアニメーショ...
-
【パワーポイントのフォントが...
-
プレゼン時のポインター
-
PowerPoint2010、2021のスライ...
-
パワーポイントで、全てのスラ...
-
パワーポイントで説明しながら...
-
PowerPointのオプションの設定...
-
PowerPointの背景について
おすすめ情報