いつもお世話になっております。
Excel2013のVBAでまた質問があります。お願いいたします。
ある表のにある値が入力されていたら、その値をコピーして1行上の4列右の列に貼り付け、もとの行の値を削除するように色々参考にしながら作りました。
ある値を例えば、"AAA”と"BBB"だとして、下記コードでなんとか最初の段階が実現できました。
あと、やりたいのは、条件を検索する列の、"AAA"もしくは"BBB"の値が連続している場合は、メッセージを出して、処理を中止にしたいです。単体で連続でも２つの組み合わせでも、この２つのうちいずれかが入力されている行が続いていたら中止です。
あと、最初にWorksheets("Sheet1").UsedRange.Columns(5)列目を指定しているんですが、実際は、複数の列を指定したいです。コピーしたり消去したりのオフセットの位置関係は変わりません。
必要なら、名前を定義して、一括で指定するのも大丈夫です。
お手数をおかけしますが、ご教授よろしくお願いいたします。
Sub TEST()
Dim c As Range
Dim firstAddress As String
' ActiveSheet.UsedRange.Select
With Worksheets("Sheet1").UsedRange.Columns(5)
Set c = .Find(What:="AAA", _
LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Range(c.Address, Range(c.Address).Offset(0, 1)).Copy Range(c.Address).Offset(-1, 4)
Range(Range(c.Address).Offset(0, -1), Range(c.Address).Offset(0, 6)).ClearContents
Set c = .FindNext(c)
If c Is Nothing Then Exit Do
Loop Until c.Address = firstAddress
End If
'別条件でもう一度
Set c = .Find(What:="BBB", _
LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Range(c.Address, Range(c.Address).Offset(0, 1)).Copy Range(c.Address).Offset(-1, 4)
Range(Range(c.Address).Offset(0, -1), Range(c.Address).Offset(0, 6)).ClearContents
Set c = .FindNext(c)
If c Is Nothing Then Exit Do
Loop Until c.Address = firstAddress
End If
End With
End Sub
いつもお世話になっております。
Excel2013のVBAでまた質問があります。お願いいたします。
ある表のにある値が入力されていたら、その値をコピーして1行上の4列右の列に貼り付け、もとの行の値を削除するように色々参考にしながら作りました。
ある値を例えば、"AAA”と"BBB"だとして、下記コードでなんとか最初の段階が実現できました。
あと、やりたいのは、条件を検索する列の、"AAA"もしくは"BBB"の値が連続している場合は、メッセージを出して、処理を中止にしたいです。単体で連続でも２つの組み合わせでも、この２つのうちいずれかが入力されている行が続いていたら中止です。
あと、最初にWorksheets("Sheet1").UsedRange.Columns(5)列目を指定しているんですが、実際は、複数の列を指定したいです。コピーしたり消去したりのオフセットの位置関係は変わりません。
必要なら、名前を定義して、一括で指定するのも大丈夫です。
お手数をおかけしますが、ご教授よろしくお願いいたします。
Sub TEST()
Dim c As Range
Dim firstAddress As String
' ActiveSheet.UsedRange.Select
With Worksheets("Sheet1").UsedRange.Columns(5)
Set c = .Find(What:="AAA", _
LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Range(c.Address, Range(c.Address).Offset(0, 1)).Copy Range(c.Address).Offset(-1, 4)
Range(Range(c.Address).Offset(0, -1), Range(c.Address).Offset(0, 6)).ClearContents
Set c = .FindNext(c)
If c Is Nothing Then Exit Do
Loop Until c.Address = firstAddress
End If
'別条件でもう一度
Set c = .Find(What:="BBB", _
LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Range(c.Address, Range(c.Address).Offset(0, 1)).Copy Range(c.Address).Offset(-1, 4)
Range(Range(c.Address).Offset(0, -1), Range(c.Address).Offset(0, 6)).ClearContents
Set c = .FindNext(c)
If c Is Nothing Then Exit Do
Loop Until c.Address = firstAddress
End If
End With
End Sub
お世話になります。一度質問を締め切ったのですが、色々やっているうちに問題がでてきたので再投稿いたしました。Excel2013です。
計画のファイルがあります。
例えば、"テーブル"シートのA列に品物A、品物B、品物C・・・、と入力されていて、B列にはA列の品物に対応して、付属A、付属B、付属Aなどと入力されているとします。実際は、品物数は数千種類あります。（この例の場合は、品物Aと品物Cは同じ付属を使う）
"計画"シートには、A列にデータの入力規則のリストより、A社やB社・・・を選択し、
さらにB列は入力規則のリストより、=INDIRECT(B2)などといれて、A列の入力規則に対して品物Aや品物B・・・などを選択します。選択するようにしています。
それで、品物Aを選んだら、その下の行に付属Aとか自動ででるようにしたいと思っています。
（列は増やしたくありません）
入力範囲のどこでも選択をできるようにしておきたいので、入力範囲にはすべてリストが設定されており、数式を入れることはできません。
とりあえず、品物を入力する範囲は、C2:C25,G2:G25範囲です。
その状態で、
とりあえずご教授いただいて下記コードまでたどりついていき通常は大丈夫なのですが、B列とC列をまとめて選択コピーして貼り付けると、付属Aと出るべきところが何も起こりません。アクティブセルが隣の列を選択しているためだと思われますが、どうすればよいか分かりません。
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True
On Error GoTo mExit
Application.EnableEvents = False
If Intersect(Target, Range("C2:C25,G2:G25")) Is Nothing Then
Application.EnableEvents = True
Exit Sub
Else
If Target.Offset(1, 0).Value = "" Then
Target.Offset(1, 0).Value = Application.WorksheetFunction.VLookup(Target.Value, Sheets("テーブル").Range("B:C"), 2, False)
Application.EnableEvents = True
End If
End If
Application.EnableEvents = True
Exit Sub
mExit:
Application.EnableEvents = True
End Sub
度々お手数をおかけいたしますが、ご教授ください。
いつもお世話になります。
指定シートの名前を削除するコードを教えていただき、試していたのですが、あるブックの時エラーになり、
: RefersToRange : <アプリケーション定義またはオブジェクト定義のエラーです。> : Range
というエラーになっていました。
ウィンドウで中身をみると、下記のコードのnの中のRefersToとかの値がまったく違うブックの名前になっており、最後に#REF!がついていたのでこれが原因なんだろうと思いますが、どうすればよいか全く分かりません。
一応、見えない名前の定義を消去するようなコードをかけて、#REF!になっていいる名前の定義を３00ほどでてきたのを消しています。
リンクの編集のコマンドもグレーになっているので、リンクもないと思います。
もともと、そのブックを改造したんだと思います。
正常に動作するものは、きちんと自分のブックのシート名になっていました。
何か方法はありますでしょうか？
Sub sumple()
Dim n As Name
For Each n In ActiveWorkbook.Names
If n.RefersToRange.Parent.Name = "データ" Then
n.Delete
End If
Next n
End Sub
いつもお世話になってます。
Excel2013のVBAより、特定のシート、例えばデータというシートに付けられた名前の定義を消す事は出来るでしょうか？他のシートの名前の定義は残しておきたいです。
ActiveSheet.Namesで指定しても消去されませんでした。
Sub Sample1()
Dim n As Name
For Each n In ActiveSheet.Names
n.Delete
Next
End Sub
