[[20150201193402]] 『同じデータ以外の検索』(Yuki) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『同じデータ以外の検索』(Yuki)

Sheet1でA1〜A2000までデータがあります。重複しないデータのみを若番順にB1,B2と順に表示したいのですが上手くいきません。どなたかアドバイスをお願いします。

           A     B    
        1 10    11 
        2 11    15 
        3 12    16
        4 10    
        5 14    
        6 10    
        7 15    
        8 16    
        9 12
       10  14
       ・  ・
       ・ ・
       ・ ・
     2000 12

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 関数でやりたいのでしょうね。

 操作であれば A列をB列にコピペして、B列で、重複の削除、並替えでできますが。

(β) 2015/02/01(日) 20:16


(β)さんありがとうございます。
重複の削除をしますと、10.12.14等も表示されるのですが・・・
重複されていないデータだけを抽出したいのですが。
(Yuki) 2015/02/01(日) 22:39

作業列が使える場合
 B1:=IF(COUNTIF($F$1:$F$10,10^4)<ROW(),"",VLOOKUP(ROW(),$D$1:$F$10,2,FALSE)-VLOOKUP(ROW(),$D$1:$F$10,3,FALSE))
  D1:=RANK(E1,$E$1:$E$10,-1)
  E1:=SUM(COUNTIF($A$1:$A$10,A1)*10^4,A1)
  F1:=COUNTIF($A$1:$A$10,A1)*10^4

作業列が使えない場合
 ユーザー定義の関数を作る
 B1:=GetData1($A$1:$A$10,ROW())
Public Function GetData1(ByVal vData As Variant, ByVal nRank As Long) As Variant

   Dim v As Variant
   Dim lngRetData() As Long
   Dim idx As Long
   Dim i As Long
   Dim j As Long
   Dim lngBuffer As Long
   ReDim lngRetData(1 To 2000)
   idx = 0
   For Each v In vData
      If Application.WorksheetFunction.CountIf(vData, v) = 1 Then
         idx = idx + 1
         lngRetData(idx) = CLng(v)
      End If
   Next
   ReDim Preserve lngRetData(1 To idx)
   For i = 1 To idx - 1
      For j = idx To i + 1
         If lngRetData(j) < lngRetData(j - 1) Then
            lngBuffer = lngRetData(j)
            lngRetData(j) = lngRetData(j - 1)
            lngRetData(j - 1) = lngBuffer
         End If
      Next
   Next
   If nRank <= idx Then
      GetData1 = lngRetData(nRank)
   Else
      GetData1 = ""
   End If
   Erase lngRetData
End Function

ざっと思いついた方法です。式中の参照範囲は10を2000に変更が必要です。
(サム) 2015/02/01(日) 22:44


重複の削除をしますと、10.12.14等も表示されるのですが・・・

 わぁ、それは失礼しました。
 UDFじゃなく、ふつうのVBAで恐縮ですが。

 Sub Test()
    Dim sl As Object
    Dim c As Range
    Dim v As Variant
    Dim i As Long

    Set sl = CreateObject("System.Collections.SortedList")

    With Range("A1", Range("A" & Rows.Count).End(xlUp))
        For Each c In .Cells
            If WorksheetFunction.CountIf(.Cells, c.Value) = 1 Then sl.Add c.Value, c.Value
        Next
    End With

    ReDim v(1 To sl.Count, 1 To 1)

    For i = 0 To sl.Count - 1
        v(i + 1, 1) = sl.getkey(i)
    Next

    Columns("B").ClearContents
    Range("B1").Resize(sl.Count).Value = v

 End Sub

(β) 2015/02/02(月) 00:12


 2000行まであるということなので、マクロの方が軽そうですが・・・
 B1セル =IFERROR(INDEX(A$1:A$2000,SMALL(IF(COUNTIF(A$1:A$2000,A$1:A$2000)=1,ROW(A$1:A$2000)),ROW(A1))),"")

 Ctrl + Shift + Enter で確定
 下にフィルコピー
(se_9) 2015/02/02(月) 07:39

    Sub t()
        Dim a
        Range("B:B").ClearContents
        With Range("A1", Range("A" & Rows.Count).End(xlUp))
            a = Filter(Evaluate("TRANSPOSE(IF(COUNTIF(" & .Address & ",IF(ROW(1:" & .Rows.Count & ")," & .Address & "))=1," & .Address & ",char(2)))"), Chr(2), False)
            If UBound(a) > 0 Then
                With .Offset(, 1).Resize(UBound(a) + 1)
                    .Value = Application.Transpose(a)
                    .Sort key1:=Range(.Address), order1:=xlAscending
                End With
            End If
        End With
    End Sub

 2000行くらいならこれでどうでしょう?
 A列にデータ、B列に出力

 ※並べ替えを忘れていたので追加 10:13
(稲葉) 2015/02/02(月) 10:02

 >若番順
 小さい値から大きい値の順(昇順)だと解釈した場合。
 B1セルに
 =IFERROR(SMALL(IFERROR(IF(FREQUENCY(A$1:A$2000,A$1:A$2000)=1,A$1:A$2000,""),""),ROW(A1)),"")
 と入力してShiftキーとCtrlキーを押しながらEnterキーで確定して下にフィルコピーしてみてくれ。

 なお、A1セルからA2000セルまですべてデータが入っている場合は
 =IFERROR(SMALL(IF(FREQUENCY(A$1:A$2000,A$1:A$2000)=1,A$1:A$2000,""),ROW(A1)),"")
 と入力して通常通りEnterで確定して下へフィルコピーでも。

 追記
 一番目の式はデータは必ず上から埋まっていくことが条件。
 途中に空セルがあると正しい結果にならない。

 さらに追記
 =IFERROR(SMALL(IF(COUNTIF(A$1:A$2000,A$1:A$2000)=1,A$1:A$2000,""),ROW(A1)),"")
 Shift+Ctrl+Enterで確定。
 途中に空セルがあっても問題ない。
(ねむねむ) 2015/02/02(月) 10:34

たくさんのアドバイスありがとうございます。
早速、TRYしてみます。
(Yuki) 2015/02/02(月) 22:54

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.