[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『A列が同じもののうち、B列の数値が多いものと少ないものを取り出したい』(tororo)
はじめまして。
下のようなシートがあります。
このシートのA列が同じもののうち、B列の一番数値の多いものと少ないものを別列に抽出したいのですが良い方法を教えて貰えないでしょうか。
事例を作ってみました。
下のようなAB列を、CDE列に抽出したいと思ってます。
A列 B列 (C列) (D列) (E列) ABC氏 20161103 ABC氏 20161103 20160501 ABC氏 20161102 XYZ氏 20151102 20151102 ABC氏 20160501 HJK氏 20160101 20150101 ABC氏 20161102 TYU氏 20161125 20131212 XYZ氏 20151102 HJK氏 20150101 HJK氏 20160101 TYU氏 20131212 TYU氏 20131212 TYU氏 20161125
宜しくお願い致します。
< 使用 Excel:Excel2016、使用 OS:Windows7 >
http://haku1569.seesaa.net/article/403458311.html
(まっつわん) 2016/11/26(土) 08:54
数式でやるとすれば。(データが1行目からとして)
C1 : =A1 C2 : =IFERROR(VLOOKUP("*",IF(COUNTIF(C$1:C1,A$1:A$100)=0,A$1:A$100),1,FALSE),"") これを Ctrl/SHift/Enter で入力し、下にフィルコピー。(この式の意味は、ほんとはよくわかっていません)
D1 : =IF(C1="","",MAX(IF(A$1:A$100=C1,B$1:B$100))) Ctrl/Shift/Enter で入力 E1 : =IF(C1="","",MIN(IF(A$1:A$100=C1,B$1:B$100))) Ctrl/Shift/Enter で入力
D1:E1 を下にフィルコピー。
(β) 2016/11/26(土) 09:20
1)C列を選んで「データ」ー「統合」 ・集計の方法:最小値に変更 ・統合先:集計するデータ範囲(またはA列B列全体)を選択 ・統合の基準:左端列にチェック 2)D列を選んで列挿入 3)再度、C列を選んで「データ」ー「統合」 ・集計の方法:最大値に変更
慣れていれば、1分ほどの操作です。
(マナ) 2016/11/26(土) 10:49
Ctrl/SHift/Enter で入力し、下にフィルコピー。(この式の意味は、ほんとはよくわかっていません
が若干の不安ではありますが・・・。
(tororo) 2016/11/26(土) 16:37
Dim rg1 As Range, rg2 As Range, rg3 As Range, rg4 As Range Range("C:D").ClearContents For Each rg1 In Range("A:A").SpecialCells(xlCellTypeConstants) Set rg2 = Range("C:C").Find(What:=rg1.Value, LookIn:=xlValues, LookAt:=xlWhole) If rg2 Is Nothing Then For Each rg3 In Range("C:C").SpecialCells(xlCellTypeBlanks) rg3.Value = rg1.Value rg3.Offset(, 1).Value = rg1.Offset(, 1).Value rg3.Offset(, 2).Value = rg1.Offset(, 1).Value For Each rg4 In Range("B:B").SpecialCells(xlCellTypeConstants) If rg4.Offset(, -1).Value = rg3.Value Then If rg4.Value > rg3.Offset(, 1).Value Then rg3.Offset(, 1).Value = rg4.Value If rg4.Value < rg3.Offset(, 2).Value Then rg3.Offset(, 2).Value = rg4.Value End If Next rg4 Exit For Next rg3 End If Next rg1 End Sub (mm) 2016/11/28(月) 11:58
βさんの方法で使ってみたところ、
A列が半角英数字の場合に上手く抽出されず、
再投稿しようとおもっていたところでした。
早速試してみたいと思います。
また他に良い方法があればご教授ください。
(AB列は全角の場合や半角の場合など様々です。)
(troro) 2016/11/28(月) 20:10
たしかにそうなりますね。半角数字や半角英数字や半角英字の場合は。 そういった場合でも C列に正しく自動記載できる数式は、専門家さんだったら可能だと思います。 その回答をお待ちください。
あるいは、C列に関しては、A列をコピペした上で、データタブの重複の削除。 あっというまの作業です。
(β) 2016/11/28(月) 20:44
もし、VBAでいいなら。
Sub Sample() Dim c As Range Dim dic As Object Dim w As Variant Dim n As Variant
Set dic = CreateObject("Scripting.Dictionary")
For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp)) If Not dic.exists(c.Value) Then dic(c.Value) = Array(Empty, Empty) w = dic(c.Value) n = c.Offset(, 1).Value If IsEmpty(w(0)) Then w(0) = n Else If n > w(0) Then w(0) = n End If If IsEmpty(w(1)) Then w(1) = n Else If n < w(1) Then w(1) = n End If dic(c.Value) = w Next
Range("C1").Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.keys) Range("D1:E1").Resize(dic.Count).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic.items))
End Sub
(β) 2016/11/28(月) 20:53
関数初心者ですので、半角対応、作業列を使います。
F1 : =IF(A1="","",IF(COUNTIF(A$1:A1,A1)=1,A1,"")) これを Ctrl/Shift/Enter で入力し ずずずっと下までフィルコピー
C1 : =IFERROR(INDEX(F:F,SMALL(IF($F$1:$F$100<>"",ROW($F$1:$F$100)),ROW(A1))),"") これも Ctrl/Shift/Enter で下にフィルコピー
D列、E列は アップした通り。
(β) 2016/11/28(月) 21:12
Sub 統合() Dim 統合元 As Range, 統合先 As Range
Set 統合元 = Columns("a:b") Set 統合先 = Columns("c")
統合先.Resize(, 3).ClearContents
統合先.Consolidate 統合元.Address(, , xlR1C1, True), xlMin, False, True Columns("d").Copy Columns("e") 統合先.Consolidate 統合元.Address(, , xlR1C1, True), xlMax, False, True
End Sub
(マナ) 2016/11/28(月) 21:56
不躾ですが、あわせて助けて頂きたいのですが、
以下のようにAB列に付随するC列も一緒にF列・H列に抽出したい場合の対処を教えて頂けないでしょうか?
将来的には、列を増やしてデーターを蓄積することになりそうですので・・・。
A列 B列 C列 D列 E列 F列 G列 H列 ABC氏 20161103 岐阜 ABC氏 20161103 岐阜 20160501 秋田 ABC氏 20161102 島根 XYZ氏 20151102 山口 20151102 山口 ABC氏 20160501 秋田 HJK氏 20160101 大阪 20150101 東京 ABC氏 20161102 島根 TYU氏 20161125 青森 20131212 福岡 XYZ氏 20151102 山口 HJK氏 20150101 東京 HJK氏 20160101 大阪 TYU氏 20131212 福岡 TYU氏 20131212 福岡 TYU氏 20161125 青森
宜しくお願い致します。
(tororo) 2016/11/28(月) 23:06
私がアップしたコードをそのまま利用するなら以下ですが、さらに列を増やして・・・ といった場合に、変更が面倒ですね。もう少し、tororoさんがメンテしやすいコードを考えてみますが、とりあえず。
Sub Sample2() Dim c As Range Dim dic As Object Dim w As Variant Dim n As Variant Dim a As String
Set dic = CreateObject("Scripting.Dictionary")
For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp)) If Not dic.exists(c.Value) Then dic(c.Value) = Array(Empty, Empty, Empty, Empty) w = dic(c.Value) n = c.Offset(, 1).Value a = c.Offset(, 2).Value If IsEmpty(w(0)) Then w(0) = n w(1) = a Else If n > w(0) Then w(0) = n w(1) = a End If End If If IsEmpty(w(2)) Then w(2) = n w(3) = a Else If n < w(2) Then w(2) = n w(3) = a End If End If dic(c.Value) = w Next
Columns("D:H").ClearContents Range("D1").Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.keys) Range("E1:H1").Resize(dic.Count).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic.items))
End Sub
(β) 2016/11/29(火) 00:02
バッチリでした。
お蔭様で今日はゆっくり寝れそうです。
有難うございます。
重ねて御礼申し上げます。
また、ご相談することもあろうと思いますが、
よろしくお願い致します。
(tororo) 2016/11/29(火) 00:08
今後、元データの列が増えた(つまり、それに応じて 展開先の列も増える)場合のメンテも考えると コードは長くなりますが、以下のほうがいいと思います。 ★展開列 のところと ★ここから ★ここまで の間のコードのみを変更追加すればOKですので。 変更、追加も、アップ済みのコードよりわかりやすいと思います。
Sub Sample3() Dim c As Range Dim dic As Object Dim w As Variant Dim n As Variant Dim x As Long Dim v As Variant Dim k As Variant Dim mx As Long Dim mn As Long
Set dic = CreateObject("Scripting.Dictionary")
For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp)) If Not dic.exists(c.Value) Then dic(c.Value) = Array(Empty, Empty, Empty, Empty) w = dic(c.Value) n = c.Offset(, 1).Value x = c.Row If IsEmpty(w(0)) Then w(0) = n w(1) = x Else If n > w(0) Then w(0) = n w(1) = x End If End If If IsEmpty(w(2)) Then w(2) = n w(3) = x Else If n < w(2) Then w(2) = n w(3) = x End If End If dic(c.Value) = w Next
ReDim v(1 To dic.Count, 1 To 5) '★ 展開列 5列 x = 0 For Each k In dic x = x + 1 mx = dic(k)(1) '最大値の行番号 mn = dic(k)(3) '最小値の行番号
v(x, 1) = k '★ここから With Rows(mx) '最大値関連列セット v(x, 2) = .Columns("B").Value v(x, 3) = .Columns("C").Value End With
With Rows(mn) '最小値関連列セット v(x, 4) = .Columns("B").Value v(x, 5) = .Columns("C").Value End With '★ここまで Next
Columns("D:H").ClearContents Range("D1").Resize(dic.Count, UBound(v, 2)).Value = v
End Sub
(β) 2016/11/29(火) 00:23
↑ 列が増えた場合、最後の2行の展開先列(今はD列〜H列)のところも変更必要です。
(β) 2016/11/29(火) 00:28
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.