[[20070706163138]] 『ダブり』(@@) ページの最後に飛ぶ

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

 

『ダブり』(@@)

AH4〜AH19374で同じ文字文字が入った時に

何か表示できる方法ってありますでしょうか??

初心者ですのでよろしくお願いいたします。


 よく解りませんが、これのこと?
 BJ
http://www.excel.studio-kazu.jp/cgi-bin/estindex/estseek2.cgi?phrase=%E9%87%8D%E8%A4%87%E5%85%A5%E5%8A%9B&perpage=10&attr=&order=&clip=-1&navi=0

ありがとうございます。

=COUNTIF($AH$4:$AH$19374,$AH$4)>1と書式で赤色を選択

上記の式(入力規則)でいれましたが?AHの列の重複が出ないのと

AH4に新宿-001

AH5に新宿-001を入力したところAI5に色付けしてしまい??

最初からと追加質問しても良いでしょうか?

    AH

【4】新宿-001

【5】新宿-001

と入力した場合にAH4とAH5のセルを色付けしたいのと(重複ならば)

名前の後に(文字数は2文字とは限らない)必ずハイフンと3桁の数字

が入らないといけない決まりがあるのですが・・

現在のミスは重複があってもそのまま入力してしまうことと、ハイフンの

あとが2桁になったままで・・なんて事で困っています。(@@)


 =COUNTIF($AH$4:$AH$19374,$AH4)>1 では

 =COUNTIF($AH$4:$AH$19374,$AH$4)>1
                          ^^^^^
 絶対参照になっているのが原因でしょう。。。1列ならAH4でいいのでは。。。
 (gon-2)
 ダブリました。失礼


入力規則での式で

=COUNTIF($AH$4:$AH$19374,$AH4)>1で入れてダブりありと表示

するようにしましたが?何をいれても注意が出てきてしまいます??

入力規則で(データ→入力規則→設定→ユーザー設定→エラーメッセージ)

を使用したいのですが・・・色とか表示しなくともダブりがある場合わかれば・・

(@@)


 入力許可は、1個だけだから・・・。
 入力値の種類は、ユーザー設定で(空白を無視するのチェックは外さないこと。)
 =COUNTIF($AH$4:$AH$19374,$AH4)=1
 BJ

 AH4〜AH19374をドラッグ選択しておいて
 条件付き書式 
 数式が =COUNTIF($AH$4:$AH4,$AH4)>1
 書式  フォント 赤

 としますとダブリ数字の2個目から赤表示となります。
 参考までに  (gon-2)

ハイフンと3桁の数字が入らないといけない決まりがあるのですが・・

入力規則

=LEN(MID(A1,FIND("-",A1)+1,5))=3


みなさんありがとうございました。

上記の=LEN(MID(A1,FIND("-",A1)+1,5))=3

をいれましたが・数式のエラーと出てしまいます??

入力規則のユーザー設定で式を入れたのが違うのでしょうか?

(@@)


 たぶん
 =AND(LEN(AH4)>4,ISNUMBER(--RIGHT(AH4,4)),--RIGHT(AH4,4)<0,COUNTIF($AH$4:$AH$19374,$AH4)=1)
 BJ


 =AND(COUNTIF($AH$4:$AH$19374,$AH4)>1,NOT(ISERROR(FIND(2,$AH4,1))))
((!))

BJさん((!))さん・ありがとうございました。

しかしエラーがでてしまい??私のやり方がいけないのでしょうか?

AH4からAH19374を指定して入力規則

データ→入力規則→設定→ユーザー設定→エラーメッセージと入力しているのですが。。

(@@)


 どうもすっきり治まりまへんなぁ・・・。
 ほならこんなんどうでっか?
 もし、気ぃにいりまへんでしたらポイしてくらはい。(可哀想・・・)
 テストとして新しいブックのSheet1のAH4から下に20000行のデータを(本物でも偽物
 でも)放り込んでおくんなはれ。

 多分ご存じでっしゃろから割愛しますが標準モジュールに下のコードをコピペします。
 戻って、重複抽出を実行しますと、Sheet1には重複したセル全てに色付けされてます。
 また、Sheet damyには重複データの行番号が抽出されとりますんで、削除するなり消去
 するなりして重複の無いデータを並べます。

 damy をDelteし、色を消しさえすれば、何度でも重複データを抽出色付けでけますから
 完全になくなるまでやりませう。
 Sheet damyに何も表示されなくなれば、重複データは存在しないキレイなデータがAH
 列に並びます。

 今度は\Sheet1/を右クリック、コードの表示を選択し、そこへもうコードをコピペ
 します。
 これで準備は完了ですワ。
 重複したデータは受け付けまへんし、不備なデータも受け付けないようになっとります。
 まぁ、まぁ、一遍試してみておくんなはれ。
      (弥太郎)
 ’標準モジュールへ
 '--------------------------
 Sub 重複抽出()
    Dim dic As Object, dic_1 As Object, i As Long, adrs As Range, tbl, x, y, ky

    Set dic = CreateObject("scripting.dictionary")
    Set dic1 = CreateObject("scripting.dictionary")
    tbl = Cells(4, 34).Resize(Cells(Rows.Count, 34).End(xlUp).Row - 3).Value
    For i = 1 To UBound(tbl, 1)
        If dic.exists(tbl(i, 1)) Then
            y = dic1(tbl(i, 1))
            x = dic(tbl(i, 1))
            ReDim Preserve x(UBound(x) + 1)
            ReDim Preserve y(UBound(y) + 1)
            x(UBound(x)) = i + 3
            y(UBound(y)) = Cells(i + 3, 34).Address(0, 0)
            dic(tbl(i, 1)) = x
            dic1(tbl(i, 1)) = y
        Else
            dic(tbl(i, 1)) = Array(tbl(i, 1), i + 3)
            dic1(tbl(i, 1)) = Array(Cells(i + 3, 34).Address(0, 0))
        End If
    Next i
    Sheets.Add
    ActiveSheet.Name = "damy"
    With Sheets("damy")
        i = 0
        For Each ky In dic.keys
            x = dic(ky)
            If UBound(x) + 1 > 2 Then
                i = i + 1
                .Cells(i + 3, 1).Resize(, UBound(x) + 1) = x
            End If
        Next ky
    End With
    With Sheets("sheet1")
        ky = Empty
        For Each ky In dic1.keys
            y = dic1(ky)
            If UBound(y) + 1 > 1 Then
                Set adrs = Union(.Range(y(0)), .Range(Join(y, ",")))
                adrs.Interior.ColorIndex = 6
            End If
        Next ky
    End With
    Set dic = Nothing
    Set dic1 = Nothing
 End Sub

 'シートモジュールへ
 '-------------------------------
 Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Column <> 34 Then Exit Sub
    If Target.Row < 4 Then Exit Sub
    Application.EnableEvents = False
    With CreateObject("vbscript.regexp")
        .Pattern = "(.+)-\d{3}$"
        If Not .test(Target) Then
            MsgBox "正確に入力しまひょ ", vbExclamation
            Target = ""
            Target.Select
            GoTo trbl
        End If
    End With
    If WorksheetFunction.CountIf(Range("ah:ah"), Target) > 1 Then
        MsgBox "そのデータは重複します", vbExclamation
        Target = ""
        Target.Select
        GoTo trbl
    End If
trbl:
    Application.EnableEvents = True
 End Sub


 >しかしエラーがでてしまい??私のやり方がいけないのでしょうか?
 これって、エラーと判断されますとかのアラートですか?
 無視してください。
 因みに・・・、○○○-000 の「-000」はダメです。001から。
 それと、「-  1」半角スペースは通っちゃいます。
 BJ

ありがとうございます。

(弥太郎)さんの式で質問があります。。

今回からのデータはハイフン無しになってしまいました。

上記の.Pattern = "(.+)-\d{3}$"の-を削除して行なったところOKのような??

一箇所で大丈夫でしょうか?

もう一つトラブルがあるのですが・・

マクロを実行すると固まった状態で??データ数が多いのが原因??A1:AN19374内で作業しています。

空のエクセルファイルだとOKなのですが??

何度も申し訳ございません。。

(@@)


 半角数字限定っちゅうなら"(.+)\d{3}$"でいけますワ。
 それとフリーズするとは重複を検索して色付けする方のマクロでっか?それともチェン
 ジイベントの方でッか?
 それがしの手元にはあんさんのお使いになっとられるデータがありまへんもんで、なん
 で固まるのかは推測しかねますワ。
 まぁ、なんにせよ固まるようでは使いモンになりまへんわなぁ。
 やっぱし条件付書式でいきますか・・・。
       (弥太郎)

(弥太郎)さんありがとうございます。数字は半角です。ハイフンがつかないだけです。

条件付き書式ですか・・・

=COUNTIF($AH$4:$AH$19374,AH4)>1で行なったのですが・ちょっと遅いような??

データが入っていないものは大丈夫なのですが・・

現在のエクセルはサイズ9.95 MB (10,435,584 バイト)です。

(@@)


 えっ???
 
 >現在のエクセルはサイズ9.95 MB (10,435,584 バイト)です。 
 そりゃ〜 重いでんな・・・
 
 ためしに、そのBOOKそのものを新規BOOKに、コピペしてみてから名前をつけて保存しても
 同じ重さですか?
 要らないもの(ゴミのようなもの)が溜まっているだけなんではないでしょうか?
 
 (キリキ)(〃⌒o⌒)b

新規サイズでも9.93 MB (10,421,760 バイト)です。

今後もまだまだ入力するので重くなるのでは・・・心配です。

入力規則では反応はいまいち・・で(弥太郎)さんの標準モジュールとシートモジュール

で色付けマクロを使用しなければ、MsgBox "正確に入力しまひょ と"そのデータは重複します"

で表示されるので使用させていただこうと思っています。

欲を言えば入力した時にたとえばAH10に新宿-001と既に入力されているとして

AH1000に新宿-001を入力したとき【AH10に重複あり】などとメッセージが出る・・・

何て夢を見ています。。欲張りで申し訳ございません。。(@@)


 > AH1000に新宿-001を入力したとき【AH10に重複あり】などとメッセージが出る・・・
 この点に於いては下のコードに差し替えて貰えれば充分ですけワ。
      (弥太郎)
 '-----------------------
 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim data As String, mch_row As Variant

    If Target.Count > 1 Then Exit Sub
    If Target.Column <> 34 Then Exit Sub
    If Target.Row < 4 Then Exit Sub
    Application.EnableEvents = False
    With CreateObject("vbscript.regexp")
        .Pattern = "(.+)-\d{3}$"
        If Not .test(Target) Then
            MsgBox "正確に入力しまひょ ", vbExclamation
            Target = ""
            Target.Select
            GoTo trbl
        End If
    End With
    If WorksheetFunction.CountIf(Range("ah:ah"), Target) > 1 Then
        data = Target
        Target = ""
        mch_row = Application.Match(data, Range("ah:ah"), 0)
        Target = data
        MsgBox "AH" & mch_row & "に重複有り", vbExclamation
        Target = ""
        Target.Select
        GoTo trbl
    End If
trbl:
    Application.EnableEvents = True
 End Sub


(弥太郎)さん何度もありがとうございました。出来るなんてビックリ!!

活用させて頂きます。

あっ!文字と半角数字の3桁ですが.Pattern = "(.+)-\d{3}$"で?

半角数字限定っちゅうなら"(.+)\d{3}$"でって書いてありましたので

(@@)


 ハイフンが必要なら上のんで、不要なら下のんでOKです。
     (弥太郎)


ありがとうございました。ハイフン不要なので"(.+)\d{3}$"で行ないます。

いろいろとありがとうございました。(@@)


コメント返信:

[ 一覧(最新更新順) ]


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