[[20070206165757]] 『入力規則の例外データを元データに追加するマクロ』(akikun) ページの最後に飛ぶ

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

 

『入力規則の例外データを元データに追加するマクロで入力範囲をふやすことができますか。』(akikun)

 お世話になります。入力規則で例外データを入力したら、元のデータに追加するVBAを
本に載っていたのを転用して作ったシートを職場で使っているのですが、入力範囲を
現在のD列に加えてL列も増やしたいのですが(行範囲はD列と同じですが)可能でしょうか。 
 尚、元のデータは名前をつけて、参照範囲を自動拡張する=INDIRECT("Sheet1!$A2:$A"&COUNTA(Sheet1$A:$A))にしています。
 下が使っているコードですが、初心者なのでよくわかりません。よろしくお願いします。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim 入力範囲 As Range
    Dim 上行 As Long, 下行 As Long
    Dim 左列 As Integer, 右列 As Integer
    Dim シート As Worksheet
    Dim 対象セル As Range

    Set シート = Sheets("Sheet1")
    Set 入力範囲 = Range("D6:D36")
    上行 = 入力範囲.Cells(1).Row
    下行 = 上行 + 入力範囲.Rows.Count - 1
    左列 = 入力範囲.Cells(, 1).Column
    右列 = 左列 + 入力範囲.Columns.Count - 1

    If Target.Row < 上行 _
        Or Target.Row > 下行 _
        Or Target.Column < 左列 _
        Or Target.Column > 右列 Then Exit Sub
    If Target.Cells(1, 1) = "" Then Exit Sub

    For Each 対象セル In シート.Range("券種名一覧")
        If Target.Cells(1, 1).Value = _
            対象セル.Value Then
            Exit Sub
        End If
    Next

    With シート.Range("券種名一覧").End(xlDown)
        .Resize(, 2).Copy .Offset(1)
        .Offset(1).Value = Target.Value
        End If

    End With
End Sub


 Excel2000以上に対応。
 
 Private Sub Worksheet_Change(ByVal Target As Range)

     Dim 入力範囲 As Range
     Dim シート As Worksheet
     Dim chk As Long

     Set シート = Sheets("Sheet1")
     Set 入力範囲 = Range("D6:D36,L6:L36")
     If Intersect(Target, 入力範囲) Is Nothing Then Exit Sub
     chk = WorksheetFunction.CountIf(シート.Range("券種名一覧"), Target.Cells(1).Value)
     If chk > 0 Then Exit Sub
     With シート.Range("券種名一覧").End(xlDown)
         .Resize(, 2).Copy .Offset(1)
         .Offset(1).Value = Target.Value
     End With
     Set 入力範囲 = Nothing
     Set シート = Nothing
 End Sub
 
(みやほりん)(-_∂)b

 みやほりんさん、ありがとうございました。

 なかなか回答がつかなかったので、できないものだと思っていました。 
元のマクロは入力範囲を四隅のセルを変数にして調べているようなので別の範囲を入れるにはどうしたもの
かと思い悩んでおりました。
 さらにスリムなコードになってびっくりしました。動作も問題ありません。
感謝です!ありがとうございました。(akikun)


コメント返信:

[ 一覧(最新更新順) ]


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