[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『入力規則の例外データを元データに追加するマクロで入力範囲をふやすことができますか。』(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.