[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『行に有るデーターの重複の削除を関数で行いたいのですが』（つむつむ）
いつも拝見させて頂き有難うございます。
A:Eに記入されている文字をG:Kに重複を削除して表示したいのです
入力されている文字数は一定ではありません
実際のデーターはA〜Oまで15有ります
A B C D E F G H I J K
1 みかん りんご みかん いちご みかん りんご いちご
2 まぐろ ほたて さんま うなぎ まぐろ ほたて さんま うなぎ
3 うさぎ うさぎ うさぎ うさぎ
4 ひつじ きりん かっぱ ねずみ いたち ひつじ きりん かっぱ ねずみ いたち
5 ヨット ヨット 潜水艦 ヨット ヨット 潜水艦
宜しくお願い致します。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
記載例だと、
A〜Eの5列で重複を除いたデータを
G〜Kの5列に記述
となってますよね。
実際のデーターはA〜Oまで15有ります とありますが、
これは、
A〜Oの15列で重複を除いたデータを
Q〜AEの15列に記述
という意味ですか？
（マリオ） 2016/02/13(土) 08:14
＜A〜Oの15列で重複を除いたデータを
＜Q〜AEの15列に記述
＜という意味ですか？
その通りです。
例として、A〜Kに示しております。
宜しくお願い致します。
（つむつむ） 2016/02/13(土) 08:28
実際は15列でも、A列から始まってることに変わりはないんですかね？
本当にA列から始まってるのなら
Q1 =IFERROR(INDEX($A1:$O1,SMALL(IF(($A1:$O1<>"")*(MATCH($A1:$O1&"",$A1:$O1&"",0)=COLUMN($A1:$O1)),COLUMN($A1:$O1)),COLUMN(A1))),"")
Ctrl＋Shift＋Enter で確定して、右下フィルコピー
または
Q1 =IFERROR(INDEX($A1:$O1,SMALL(INDEX((($A1:$O1="")+(MATCH($A1:$O1&"",$A1:$O1&"",0)<>COLUMN($A1:$O1)))*10^7+COLUMN($A1:$O1),0),COLUMN(A1))),"")
普通にEnterだけで確定して、右下フィルコピー
データ量が多いとアレですけど、15列ぐらいならなんてことないですね。 （笑） 2016/02/13(土) 12:43
つむつむ さん
関数でのやりかたは、
（笑）さんの2つの目の「Q1=〜」で解決なのを確認しましたが、
VBAで作ってみたので、よろしかったら、どうぞ。
■STEP1
「Alt+F11」で、Visual Basicを開いて、
ThisWorkbook上で、右クリック→挿入→標準モジュール→Module1作成
Module1のコード表示欄に、下記のコードを貼り付け。
その後、ファイルの種類を「Excel 97-2003ブック」にして、適当なファイル名で保存（拡張子はxls）
Const row1 As Long = 1 'データ開始行の設定
Const col1 As Long = 1 'データ開始列の設定（A列）
Const col2 As Long = 15 'データ最終列の設定（O列）
Dim myVal As Variant, c As Variant, myKey As Variant
Dim i As Long, j As Long, row2 As Long, dic As Object
With ActiveSheet.Range(Columns(col1), Columns(col2)) '（A〜O列）
row2 = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row 'データ最終行を探す
End With
For i = row1 To row2 '行ごとの処理
Set dic = CreateObject("Scripting.Dictionary") '辞書の設定
myVal = Range(Cells(i, col1), Cells(i, col2)).Value 'データを配列に格納（A〜O列）
For Each c In myVal
If Not c = Empty Then
If Not dic.Exists(c) Then dic.Add c, "" 'dicへデータを格納
End If
Next
myKey = dic.Keys
For j = 0 To dic.Count - 1
Cells(i, j + col2 + 2) = myKey(j) '（「col2」+「2」）列から書き出し
Next j
Set dic = Nothing '辞書データ削除
Next i
End Sub
■STEP2
保存したファイル（拡張子xls）を開いて、
適当なシートに、次のデータ（A1:O6）を貼り付けてください。
A B C D E F G H I J K L M N O 1 あ あ い い い う う う え え え 2 か か か き き き く く く け け 3 さ さ し し す す せ せ 4 た と ち て つ つ て ち と た 5 の の の ね ね ね ぬ ぬ ぬ に に に な な な 6 は ひ ふ へ ほ ま み む め も や ゆ よ ら り
■STEP3
「Alt+F8」でマクロが開くので、
「同じ行に重複したデータを貼りつける」を実行する
すると、（Q1:AE6）の範囲にデータが書き込まれます。
Q R S T U V W X Y Z AA AB AC AD AE 1 あ い う え 2 か き く け 3 さ し す せ 4 た と ち て つ 5 の ね ぬ に な 6 は ひ ふ へ ほ ま み む め も や ゆ よ ら り
マリオ様に作って頂きましたVBAでも
笑様に作って頂きました配列数式や普通の数式でも
希望通りの結果を得る事が出来ました。
今回は、笑様に教えて頂きました普通の数式を使用させて頂きます。
会社の仕事が楽になります。
本当に有難うございました。
（つむつむ） 2016/02/13(土) 13:30
補足というか訂正というか。
> Q1 =IFERROR(INDEX($A1:$O1,SMALL(INDEX((($A1:$O1="")+(MATCH($A1:$O1&"",$A1:$O1&"",0)<>COLUMN($A1:$O1)))*10^7+COLUMN($A1:$O1),0),COLUMN(A1))),"") 「10^7」としてるところ、ありますよね。 最初、INDEXの範囲を、INDEX(1:1,･･･ と「1:1」（行全体）にしていたので テキトーに 10^7 にしました（Excel2010の最大列数以上の数値ってことです）
INDEX($A1:$O1,･･･ と範囲を限定した場合、10^7のままでも問題はないですけど、 この場合は15列なので「15」以上の数値なら何でもいいです。
たとえば「100」でもオッケー
Q1 =IFERROR(INDEX($A1:$O1,SMALL(INDEX((($A1:$O1="")+(MATCH($A1:$O1&"",$A1:$O1&"",0)<>COLUMN($A1:$O1)))*100+COLUMN($A1:$O1),0),COLUMN(A1))),"")
以上、参考まで。 （笑） 2016/02/13(土) 14:07
'【1】
'■（追加）はじめに、Q〜AE列のデータ（値、数式）を消去
'A〜O列のデータが書き換えられた後に、プログラムを実行すると、
'前に書き込んだデータが残っていたりするので。
ActiveSheet.Range(Columns(col2 + 2), Columns((col2 + 2) + (col2 - col1 + 1))).ClearContents
'【2】
'If Not c = Empty Then'■（修正前）
If c <> "" Then '■（修正後）0のデータを書き出すようにするため
Const row1 As Long = 1 'データ開始行の設定
Const col1 As Long = 1 'データ開始列の設定（A列）
Const col2 As Long = 15 'データ最終列の設定（O列）
Dim myVal As Variant, c As Variant, myKey As Variant
Dim i As Long, j As Long, row2 As Long, dic As Object
'■（追加）はじめに、Q〜AE列のデータ（値、数式）を消去
ActiveSheet.Range(Columns(col2 + 2), Columns((col2 + 2) + (col2 - col1 + 1))).ClearContents
With ActiveSheet.Range(Columns(col1), Columns(col2)) '（A〜O列）
row2 = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row 'データ最終行を探す
End With
For i = row1 To row2 '行ごとの処理
Set dic = CreateObject("Scripting.Dictionary") '辞書の設定
myVal = Range(Cells(i, col1), Cells(i, col2)).Value 'データを配列に格納（A〜O列）
For Each c In myVal
'If Not c = Empty Then'■（修正前）
If c <> "" Then '■（修正後）0のデータを書き出すようにするため
If Not dic.Exists(c) Then dic.Add c, "" 'dicへデータを格納
End If
Next
myKey = dic.Keys
For j = 0 To dic.Count - 1
Cells(i, j + col2 + 2) = myKey(j) '（「col2」+「2」）列から書き出し
Next j
Set dic = Nothing '辞書データ削除
Next i
End Sub
■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
どなたか、次の【3】のエラー対策を教えてください。ん〜。
'【3】
'A〜O列に何もデータがないとき、「row2」（データ最終行を探す）でエラーとなる
'→エラー対策したい
'A〜O列に何もデータ(数値の0も含む！)がないとき、Exit Subしたい
■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
あと、（笑）さんの関数（数式）に関してなんですが、
列の最大値を数式で求められないですかね？VBAだと、Columns.Countですが
（マリオ） 2016/02/13(土) 16:55
式の補足説明有難うございます。
勉強になります。
マリオ様
ご連絡有難うございます。
＞A〜O列に何もデータがないとき、「row2」（データ最終行を探す）でエラーとなる
気が付きませんでしたが、確かにA〜Oにデーターが無い場合不具合となる様です。
最後までのフォロー有難うございます。
（つむつむ） 2016/02/13(土) 17:24
全部見ているわけではありませんが・・・。 >'A〜O列に何もデータがないとき、「row2」（データ最終行を探す）でエラーとなる Findメソッドは、そもそも検索文字があるRangeオブジェクトを返すメソッドです。 見つかったRangeオブジェクトが返されるから、有効なRowプロパティが返されるのです。
dim frng as range
・ ・
set frng=.Find("*", , xlFormulas, , xlByRows, xlPrevious)
if not frng is nothing then row2=frng.row
なのでしょうねえ 尚、ロジック全体は見ていませんので、提示したコードでエラー回避は判断してください
>VBAだと、Columns.Countですが
数式にも columns(セル範囲) というのがありますから 調べてみてください
（ichnose） 2016/02/13(土) 17:52
ありがとうございます。
数式のcolumns（セル範囲）調べてみます。あったかな〜。
■dim frng as range
■set frng=.Find("*", , xlFormulas, , xlByRows, xlPrevious)
■if not frng is nothing then row2=frng.row
やってみたのですが、frngでオブジェクトが何チャラ〜でエラーに
なっちゃいました。
初歩的なやり方ですが、row2の前の行に、On Error GoTo myError
を置いてみました。
（マリオ） 2016/02/13(土) 18:37
次のコード（***〜***間）を、
「Module1」ではなく、「Sheet1」のコード表示欄に貼り付けてください。
Const row1 As Long = 1 'データ開始行の設定
Const col1 As Long = 1 'データ開始列の設定（A列）
Const col2 As Long = 15 'データ最終列の設定（O列）
Dim myVal As Variant, c As Variant, myKey As Variant
Dim i As Long, j As Long, row2 As Long, dic As Object
If Intersect(Target, Range(Columns(col1), Columns(col2))) Is _
Nothing Then End '（A〜O列）以外であれば終了’★★★
'■（追加）はじめに、Q〜AE列のデータ（値、数式）を消去
ActiveSheet.Range(Columns(col2 + 2), Columns((col2 + 2) + (col2 - col1 + 1))).ClearContents
With ActiveSheet.Range(Columns(col1), Columns(col2)) '（A〜O列）
On Error GoTo myError '■■■追加
row2 = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row 'データ最終行を探す
End With
For i = row1 To row2 '行ごとの処理
Set dic = CreateObject("Scripting.Dictionary") '辞書の設定
myVal = Range(Cells(i, col1), Cells(i, col2)).Value 'データを配列に格納（A〜O列）
For Each c In myVal
'If Not c = Empty Then'■（修正前）
If c <> "" Then '■（修正後）0のデータを書き出すようにするため
If Not dic.Exists(c) Then dic.Add c, "" 'dicへデータを格納
End If
Next
myKey = dic.Keys
For j = 0 To dic.Count - 1
Cells(i, j + col2 + 2) = myKey(j) '（「col2」+「2」）列から書き出し
Next j
'Set dic = Nothing '辞書データ削除'■■■削除
Next i
myError: '■■■追加
'If Err.Number <> 0 Then MsgBox "A〜O列にはデータが１つもありません" '■■■追加（表示がうざそうなのでコメント化）
Set dic = Nothing '辞書データ削除'■■■追加
ActiveSheet.Range(Columns(col1), Columns((col2 + 2) + (col2 - col1 + 1))) _
.AutoFit 'A〜AE列のセル幅を自動調整
End Sub
'【3】の対策（下の３か所）
'If Err.Number <> 0 Then MsgBox "A〜O列にはデータが１つもありません" '■■■追加
Set dic = Nothing '辞書データ削除'■■■追加
ActiveSheet.Range(Columns(col1), Columns((col2 + 2) + (col2 - col1 + 1))) _
.AutoFit 'A〜AE列のセル幅を自動調整
今まで、「Module1」に記述してきましたが、
これだと、いちいち、プログラムを実行しなくてはいけない。
関数を使っているときのように、（A〜O列）の値が変わったときに、
即座に（Q〜AE列）の値を変更させたい。
そこで、
データを貼りつけたシート（例えば、「Sheet1」）に
次のコードを記述
今までのコードの
■Sub 同じ行に重複を削除したデータを貼りつける()
だったところが、
■Private Sub Worksheet_SelectionChange(ByVal Target As Range)
に変わっています。
また、
If Intersect(Target, Range(Columns(col1), Columns(col2))) Is _
Nothing Then End '（A〜O列）以外であれば終了’★★★
を追加しています。
（マリオ） 2016/02/13(土) 18:38
■Dim i As Long, j As Long, row2 As Long, dic As Object
の次の行に追加
Application.ScreenUpdating = False '画面の描画をOFFにします
■End Sub
の前の行に追加
Application.ScreenUpdating = True '画面の描画をONに戻します
（マリオ） 2016/02/13(土) 19:33
>dim frng as range
>・
>・
>set frng=.Find("*", , xlFormulas, , xlByRows, xlPrevious)
>if not frng is nothing then row2=frng.row
私が提示したコード、frngという変数は、3行に書かれています。 >frngでオブジェクトが何チャラ〜でエラーに
どの行で どのようなエラーが発生したのかを正確に記述してください。
set frng=.Find("*", , xlFormulas, , xlByRows, xlPrevious)
ここでエラーなのかなあ と想像していますが・・・。
まさか 最後に .Rowを残しているなんてことは ないですよね？
On Errorを使った処理、私は それでも良いと思っています。
が、その場合、どのようなエラーを拾うのか？を規定する必要があります。
Findメソッドは、検索文字列が見つからない場合は、Nothingが返ります。
見つかれば、そのセルのRangeオブジェクトが返ります。
見つからなければ、Nothingが返る そのNothingに対して Rowプロパティを取得しようとするから、 エラーになる、そのトラップをOn Errorで拾う と言うならわかります。
が、それを分けただけの
>set frng=.Find("*", , xlFormulas, , xlByRows, xlPrevious)
ではエラーに成ると記述された、ということは、他にも（検索文字が見つからない以外）エラー原因が潜んでいると想像してしまいます。
On Errorを使うなら、この辺りを解決された方がよいと思いますよ！！
因みにOn Error を使うなら 可能な限り適応範囲を限定する方が良いので
With ActiveSheet.Range(Columns(col1), Columns(col2)) '（A〜O列）
On Error GoTo myError '■■■追加
row2 = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row 'データ最終行を探す
on error goto 0
End With
とした方が良いと思いますよ
（ichnose） 2016/02/13(土) 20:13
失礼いたしましたm(_ _)mぺこぺこぺこ
■まさか 最後に .Rowを残しているなんてことは ないですよね？
それしか考えられません。凡ミスです！
下記(***以下)のコードで問題ありませんでした。
■On error goto 0
後からコードを見直した時に、エラーが起こる箇所
が分かりやすい方がいいですね。ご指摘いただき、ありがとうございます。
m(_ _)mぺこぺこぺこ
つむつむ さんも、見てましたら、On error goto 0を追記してください。
On Error GoTo myError
row2 = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
On error goto 0
■数式にも columns(セル範囲) というのがありますから 調べてみてください
やっぱり、関数（数式）：columns(セル範囲)で、
列の最大値の求め方が分かりません。
教えてくださ〜い。
Excel2003の列数は256、
Excel2007の列数16,384
With ActiveSheet.Range(Columns(col1), Columns(col2))
Set frng = .Find("*", , xlFormulas, , xlByRows, xlPrevious)
If Not frng Is Nothing Then
row2 = frng.Row
Else
GoTo myError
End If
End With
'（省略）
myError:
If frng Is Nothing Then MsgBox "A〜O列にはデータが１つもありません"
Set frng = Nothing
（マリオ） 2016/02/13(土) 22:13
マリオ様
VBAが進化していてビックリしました。
データーを張付けただけで計算されるんですね
有難うございました。
（つむつむ） 2016/02/14(日) 07:01
To マリオさん
目に留まらないかもしれませんし、間違いということではないので、いらぬおせっかいですけど。
For i = row1 To row2 '行ごとの処理
Set dic = CreateObject("Scripting.Dictionary") '辞書の設定
ループのたびに新規オブジェクトとして生成してもよろしいんですが
Set dic = CreateObject("Scripting.Dictionary") '辞書の設定
For i = row1 To row2 '行ごとの処理
dic.RemoveAll
という使い方もできます。ご参考まで。
（β） 2016/02/14(日) 08:15
■マリオさん
＞やっぱり、関数（数式）：columns(セル範囲)で、
＞ 列の最大値の求め方が分かりません。
あれ、ＶＢＡで書くときだって
特定のシート.Columns.Count もしくは
セル範囲.Columns.Count じゃないですか。
セル範囲.Columns.Countと書いて２５６なりを返すための「セル範囲」は
どこでしょうということですよね。Cells以外で。
■つむつむさん
もしかしてコメントをいただく場合
わたしには様は勘弁してくださいな。
（ 佳 ） 2016/02/14(日) 09:16
＞dic.RemoveAll
知らなかったです。ありがとうございます。
■佳さん
？VBAじゃなくて、エクセルの数式欄でのことなんですが、
例えば、「A1」セルの数式欄に、
「=COLUMN()」で「1」
「=COLUMN(B1)」で「2」
Excel2013で、
xlsxのファイルの「A1」セルに、
「=COLUMNS($1:$1048576)」で「16384」←最大列数
xlsのファイルの「A1」セルに、
「=COLUMNS($1:$65536)」で「256」←最大列数
xlsxとxlsの区別なしに、
「$1:$1048576」と「$1:$65536」を使わずに、
COLUMNまたは、COLUMNS関数を使って、
最大列数を求めたいのですが。
（マリオ） 2016/02/14(日) 10:25
＞？VBAじゃなくて、エクセルの数式欄でのことなんですが、
難しいことをするときは、使い慣れた道具を使うべし、と言います。
マリオさんにとっては、ＶＢＡ的発想のほうが考えやすいかなと思ったので
そういう文脈でコメントしました。
＞「=COLUMNS($1:$65536)
２５６を得るために、６５５３６行までの全行が必要ですか？
まあ、Excel2013でもこの式で16384が返るはずなので、
あながち間違いとはいえませんが （＾＾
ＶＢＡでそう書いたら なぜマジックナンバーを使うのかと
ツッコミが入りそうです。
（ 佳 ） 2016/02/14(日) 10:55
佳さんから説明がありますが蛇足で。
Columnsプロパティの親（Parent) は、佳さん指摘の通り、シートオブジェクトです。 残念ながら Application ではありません。
で、親（シート）を省略すると、シートモジュールでは、そのコードが書かれたシート、 そのほかのモジュールでは、たまたま、その時にアクティブになっているブックのアクティブシートになります。
ですから、xlsxブックが最前面にあれば Columns.Count は 16384 、xlsブックが最前面にあれば 256 になります。 これは Rows に関しても同様です。
（β） 2016/02/14(日) 11:24
そうか、ファイルが（xls、xlsxどちらでも）何であろうと、数式
=COLUMNS($1:$1)
で最大列数、取得できますね(^^♪
セル範囲で、「$A:$A」はよく使いますが、
「$1:$1」に気づかなかった〜
（マリオ） 2016/02/14(日) 14:11
の数式の「10^7」のとこですが、「COLUMNS($1:$1)」と置き換えてもいいんですね。
Q1 =IFERROR(INDEX($A1:$O1,SMALL(INDEX((($A1:$O1="")+(MATCH($A1:$O1&"",$A1:$O1&"",0)<>COLUMN($A1:$O1)))*COLUMNS($1:$1)+COLUMN($A1:$O1),0),COLUMN(A1))),"")
数式の意味、後で考えよ(^^♪
だれか説明して〜
（マリオ） 2016/02/14(日) 14:15
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.