[[20020530162213]]　『リストで選択した人名を表から消したい』（YOU）　ページの最後に飛ぶ

『リストで選択した人名を表から消したい』（YOU）

人員配置表を作成したいのですが、＜データー・・・入力規則・・・リスト＞の方法で人名をリスト形式で入録していきます。そこで問題だったのが使用した人名が分からなくなり、ダブって配置してしまう事です。　よってすでに配置した人が一覧表の中から消えて、配置の済んでない人の名前のみ残るようにしたいのですが。

　良い方法　教えてください。

 （みやほりん）が2005/2/8	09:47 PM　にレス上げしました。
　
【重複しない入力規則リスト】
A列に入力規則
B列に実際のリスト、
C列に入力規則用のリストを設定した例。
	A	B	C
1	入力規則	リスト	入力規則用リスト
2	あああ	あああ	いいい
3	かかか	いいい	ううう
4	おおお	ううう	えええ
5		えええ	
6		おおお	
7		かかか	
　
C2セルへ下記数式。
=TEXT(INDEX($B$2:$B$101,SMALL(IF(COUNTIF($A$2:$A$101,$B$2:$B$101)=0,ROW($A$1:$A$100)),ROW(A1))),"#")
配列数式でCtrl+Shift+Enter。
　
C2フィルハンドルダブルクリックでフィル。。
C列にできたデータを入力規則のリスト範囲とします。
リストは上に詰まっていくのですが、数式では「クリア」にできないので、
入力規則リスト下方に空白が残っていくのが不満。
良く似たトピックがあったと思ったのですが見つからない。
（みやほりん）

 フィルタオプションで重複を除いては？
  (INA)

 連続して入力規則のリストから選択していくケースを考えたので、
その都度リストにフィルタリングするのは手間ですが、
Changeイベントを絡めればいけますね。
　
今、悩んでいるのは
＞入力規則リスト下方に空白が残っていくのが不満。
VBA使わない方法で、入力規則用のリストを必要な
セル範囲だけに限定するような方法なんですが・・・
うまい数式ありませんかね。
（みやほりん）

 参照するセル範囲が固定されているのなら、入力規則の範囲を
=OFFSET($C$2,0,0,COUNTA($C$2:$C$7)-COUNTBLANK($C$2:$C$7),1)
のようにするのはどうなんでしょう?
前に、それぐらいなら・・・・と書かれたような気がするので
何か他の方法があったと思うのですが思い出せない。
　　(Hatch)

 同じ発想です。入力規則のリスト範囲を
 =OFFSET($C$2,0,0,SUMPRODUCT((LEN($C$2:$C$7)<>0)*1),1)
 （純丸）

 TO　Hatchさん
なるほど、COUNTBLANKで「""」カウントしますね。
ダメかと勘違いしてました。
TO　純丸さん
SUMPRODUCT＆LENでもオッケーです。
リストの参照範囲で配列数式には出来ないなぁ、とこちらも思い込み。
SUMPRODUCTなら関係ないですなぁ。
ご協力感謝します。
（みやほりん）

 これでも、いいみたいですよ
=OFFSET($C$2,,,SUM((LEN($C$2:$C$7)<>0)*1))
（SoulMan）

 いけますねぇ～。そうか、条件に合うセルの数を数えるだけだから
SUMで良いわけだ。納得。
（みやほりん）

 ちょっとお遊びで作ってみました。
シートモジュールに貼り付けて、A列に何か入力してから、
B1:H10の範囲を選択してみてください。。。
例によってマニアックなので、数に限りがあるかもです。。
どうでしょう？
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyA As Variant, MyAry() As Variant
Dim i As Long, k As Long
Dim x As Variant
If Target.Count > 1 Then Exit Sub
If Target.Column = 1 Then Exit Sub
If IsEmpty(Target.Value) Then Exit Sub
Application.EnableEvents = False
With Me
    If Application.CountA(.Range("A1", .Range("A65536").End(xlUp))) > 1 Then
        MyA = .Range("A1", .Range("A65536").End(xlUp)).Value
        x = Application.Match(Target.Value, .Range("A1", .Range("A65536").End(xlUp)), 0)
        If Not IsError(x) Then
            For i = LBound(MyA, 1) To UBound(MyA, 1)
                If Not IsEmpty(MyA(i, 1)) And MyA(i, 1) <> Target.Value Then
                    k = k + 1
                    ReDim Preserve MyAry(1 To 1, 1 To k)
                    MyAry(1, k) = MyA(i, 1)
                End If
            Next
            .Range("A:A").EntireColumn.ClearContents
            .Range("A1").Resize(UBound(MyAry, 2)).Value = Application.Transpose(MyAry)
            .Range("A1", .Range("A65536").End(xlUp)).Name = "MyList"
        End If
        Erase MyA, MyAry
    End If
End With
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
    With Me
        .Range("A1", .Range("A65536").End(xlUp)).Name = "MyList"
        If Not Intersect(Target, .Range("B1:H10")) Is Nothing Then
            With Target.Validation
                .Delete
                .Add Type:=xlValidateList, Formula1:="=MyList"
                .ShowError = False
            End With
        End If
    End With
End Sub
（SoulMan）

 あっあ～～、、消してもリストが減らないように考えていたら、、自分でも
わからなくなったべ（￣□￣；）！！
ご飯食べてこよぉ～～っと、、また、暇な時に考えます。(;^_^A あせあせ･･･
Option Explicit
Dim SMyStr As String
Dim MyB As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyA As Variant, MyAry() As Variant
Dim C As Range
Dim i As Long, k As Long, j As Long
Dim x As Variant, EMyStr As String
If Intersect(Target, Range("B1:H10")) Is Nothing Then Exit Sub
Application.EnableEvents = False
With Me
    If Target.Count > 1 Then
    For j = LBound(MyB, 2) To UBound(MyB, 2)
        For i = LBound(MyB, 1) To UBound(MyB, 1)
            x = Application.Match(MyB(i, j), .Range("A1", .Range("A65536").End(xlUp)), 0)
            If Not IsEmpty(MyB(i, j)) And IsError(x) Then
                k = k + 1
                ReDim Preserve MyAry(1 To 1, 1 To k)
                MyAry(1, k) = MyB(i, j)
            End If
        Next
    Next
        If k > 0 Then
            .Range("A65536").End(xlUp).Offset(1).Resize(UBound(MyAry, 2)).Value = Application.Transpose(MyAry)
            .Range("A1", .Range("A65536").End(xlUp)).Sort _
                Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess
            Erase MyAry
        End If
    Else
        EMyStr = Target.Value
        If Application.CountA(.Range("A1", .Range("A65536").End(xlUp))) > 1 Then
            If SMyStr <> EMyStr Then
                MyA = .Range("A1", .Range("A65536").End(xlUp)).Value
                x = Application.Match(EMyStr, .Range("A1", .Range("A65536").End(xlUp)), 0)
                If Not IsError(x) Then
                    For i = LBound(MyA, 1) To UBound(MyA, 1)
                        If Not IsEmpty(MyA(i, 1)) And MyA(i, 1) <> EMyStr Then
                            k = k + 1
                            ReDim Preserve MyAry(1 To 1, 1 To k)
                            MyAry(1, k) = MyA(i, 1)
                        End If
                    Next
                    .Range("A:A").EntireColumn.ClearContents
                    .Range("A1").Resize(UBound(MyAry, 2)).Value = Application.Transpose(MyAry)
                    .Range("A1", .Range("A65536").End(xlUp)).Name = "MyList"
                    Erase MyAry
                End If
                x = Application.Match(SMyStr, .Range("A1", .Range("A65536").End(xlUp)), 0)
                If SMyStr <> "" Then
                    If IsError(x) Then
                        MyA = .Range("A1", .Range("A65536").End(xlUp).Offset(1)).Value
                        MyA(UBound(MyA, 1), 1) = SMyStr
                        .Range("A:A").EntireColumn.ClearContents
                        .Range("A1").Resize(UBound(MyA, 1)).Value = MyA
                        .Range("A1").Resize(UBound(MyA, 1)).Sort _
                        Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess
                    End If
                End If
            Erase MyA
            End If
        End If
    End If
End With
Application.EnableEvents = True
SMyStr = EMyStr
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then
        MyB = Target.Value
    Else
        SMyStr = Target.Value
        With Me
            .Range("A1", .Range("A65536").End(xlUp)).Name = "MyList"
            If Not Intersect(Target, .Range("B1:H10")) Is Nothing Then
                With Target.Validation
                    .Delete
                    .Add Type:=xlValidateList, Formula1:="=MyList"
                    .ShowError = False
                End With
            End If
        End With
    End If
End Sub
（SoulMan）

 便乗質問です。
 いつもお世話になります。
 ＞=OFFSET($C$2,,,SUM((LEN($C$2:$C$7)<>0)*1))
 上記の数式は、エクセルのメニューのデータ→入力規則→ダイアログ（設定）で
 入力値の種類でリストを選択→元のデータ欄に入れればいいのでしょうか？
 これで確認したところ、入力済みの名前がドロップダウンリストに残ってますが
 使い方間違ってるでしょうか？(EXCEL 97)
 (EVO7)

 C列のデータが未入力のものだけ残るようになっていますか？
私の最初のレスからの流れなので、
下記の状況を満たした状況で、入力規則の「もとのデータ」に設定するものです。
　
【B列に全項目のリストが入力されている】
【C列へは未入力のデータを表示する数式が入力されている】
　　＞C2へ
　　＞=TEXT(INDEX($B$2:$B$101,SMALL(IF(COUNTIF($A$2:$A$101,$B$2:$B$101)=0,ROW($A$1:$A$100)),ROW(A1))),"#")
　　＞配列数式でCtrl+Shift+Enter。
（みやほりん）

 あ、そういうことだったんですね。
 今、ご教授頂いた通り入力して確認しました。
 空白の残りも無く、うまく入力できるようになりました。
 ありがとう御座いました。
 (EVO7)

コメント返信：

[ 一覧(最新更新順) ]

[[20020530162213]] 『リストで選択した人名を表から消したい』（YOU） ページの最後に飛ぶ

[[20020530162213]]　『リストで選択した人名を表から消したい』（YOU）　ページの最後に飛ぶ