[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『実行時ｴﾗｰ１３ 型が一致しません と…』 （ゆき）
[[20100826182137]] で 大変に大変に お世話になりました ありがとうございましたm(__)m
すみません 入力していってみたら 教えてもらう前に作っていたシートから 今回新しく 教えてもらったシートに写そうと 今 コピーして貼り付けして 直していた所なのですが
昔作っていたF列に 入れてあるものを まとめてコピーして（F4：F80位まで） 新しく作ったF列に それを 貼り付けをすると
実行時エラー１３ 型が一致しません と出て デバック を押すと マクロの If .Value = "" Then という所が黄色くなっています
F列に 一つずつ言葉を ガソリン とか入れていくには きちんと教えて頂いたマクロの通りになるのですが 何行かを まとめてコピーしたものを 貼り付けると このエラーが出てきます やはり 一行ずつ 入力していく方法しかないという事になりますでしょうか？
すみません m(__)m 宜しくお願い致します m(__)m
おはようございます。 私の書いたコードは複数セルのコピペにも対応してます。 （ウッシ）
ウッシさんのコードもやってみてくださいね。。
わたしの場合ですと、 シートタブ→右クリック→コードの表示で、 そのにあるコードに下記のコードを張り付けてみて。コードの差し替えです。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, j As Integer, k As Integer
Application.EnableEvents = False
If Not Intersect(Target, Range("F:F")) Is Nothing Then
Application.EnableEvents = False
Me.Unprotect
For Each Target In Selection
With Target
If .Value = "" Then
With .Offset(, 1)
.Value = ""
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
End With
Else
k = WorksheetFunction.CountIf(Sheets("Sheet2").Range("A:A"), Target.Value)
If k = 1 Then
j = WorksheetFunction.Match(Target.Value, Sheets("Sheet2").Range("A:A"), 0)
Sheets("Sheet2").Cells(j, 2).Copy Target.Offset(, 1)
Else
j = WorksheetFunction.Match("その他出費", Sheets("Sheet2").Range("B:B"), 0)
Sheets("Sheet2").Cells(j, 2).Copy Target.Offset(, 1)
End If
End If
End With
Next Target
Me.Protect
Application.EnableEvents = True
End If
End Sub
そっかー、このような事も想定しなくっちゃ ^^;
ちょこっと訂正しました。9:35 8/31
(kei)
（ゆき）ウッシさん keiさん ありごとうございます ウッシさんのを やってみたら すみません(~_~;) 名前が適切ではありません jyunbbi とエラーが出て OK とヘルプ と出て Sub jyunbbi の所が青くなっていました すみません (-_-;) うまくいかず すみません (-_-;) それと keiさん すみません この間のコタさんのを消してから 上のを貼り付けてやったら 色も言葉も出てこず(~_~;) 何故か F4に電話代と入れたらG４は 通信費 に変換されず 色も変わらず、G4は何も変化せず 隣のH4に元々 黄色が入れてあるのですが H4が パッと 色がなくなります すいません… (-_-;)
それで もしかして下に貼り付けるのかなと思いまして この前の コタさんのマクロの下に貼り付けたら ｺﾝﾊﾟｲﾙｴﾗｰ 名前が適切ではありません と出て Private Sub Worksheet_Change(ByVal Target As Range の所が青くなっています (-_-;)
すみません私 またまた何が間違っていますでしょうか m(__)m 宜しくお願い致します m(__)m
こんにちは
「jyunbbi」が二つあると思う思うので削除して下さい。
あと、まだ保護はしたままなのですか？ してあるなら、こちらに差し替えて下さい。
Sub jyunbbi()
Application.EnableEvents = False
With Worksheets("収支表").Range("G:G")
.Parent.Unprotect
.Value = .Value
.Parent.Protect
End With
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Variant
Dim r As Range
Dim t As Range
Set t = Intersect(Target, Range("F:F"))
If t Is Nothing Then Exit Sub
Application.EnableEvents = False
Me.Unprotect
For Each r In t
With r
If .Value = "" Then
With .Offset(, 1)
.Value = ""
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
End With
Else
j = Application.Match(.Value, Sheets("Sheet2").Range("A:A"), 0)
If IsError(j) Then
j = Application.Match("それ以外", Sheets("Sheet2").Range("A:A"), 0)
End If
Sheets("Sheet2").Cells(j, 2).Copy Target.Offset(, 1)
End If
End With
Next
Me.Protect
Application.EnableEvents = True
End Sub
「エラーで終了した時」は何らかの原因でイベントマクロを中断終了した時に実行して下さい。
Sub エラーで終了した時()
Application.EnableEvents = True
End Sub
（ウッシ）
ウッシさんと、わたしので混乱させちゃいますね。^^;
とりあえず、二人のブックを別々にしておいて検証してみて。 わたしの場合ですと、 「収支表シート」のシートタブ→右クリック→コードの表示で、 そのにあるコードを一度全部消してから、下記のコードを張り付けてみて。
もし、なにも変化がなく「おかしー?」と思ったら、
最後に書いてある（ウッシさんのをパクッたもの m(__)m）で、「動かないときに使う」マクロを実行してネ。
↓ココから
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, j As Integer, k As Integer
If Not Intersect(Target, Range("F:F")) Is Nothing Then
Application.EnableEvents = False
Me.Unprotect
For Each Target In Selection
With Target
If .Value = "" Then
With .Offset(, 1)
.Value = ""
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
End With
Else
k = WorksheetFunction.CountIf(Sheets("Sheet2").Range("A:A"), Target.Value)
If k = 1 Then
j = WorksheetFunction.Match(Target.Value, Sheets("Sheet2").Range("A:A"), 0)
Sheets("Sheet2").Cells(j, 2).Copy Target.Offset(, 1)
Else
j = WorksheetFunction.Match("その他出費", Sheets("Sheet2").Range("B:B"), 0)
Sheets("Sheet2").Cells(j, 2).Copy Target.Offset(, 1)
End If
End If
End With
Next Target
Me.Protect
Application.EnableEvents = True
End If
End Sub
Sub 動かないときに使う()
Application.EnableEvents = True
End Sub
↑ココまで
(kei)
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Exit_sub
'
'処理
'
Exit_sub:
MsgBox Err.Number & vbNewLine & Err.Description
Application.EnableEvents = True
End Sub
（ramrun）
こんにちは 最終的にはそうするといいんですけど、エラーが出るうちはどこで止まったか教えて欲しいので。 （ウッシ）
ウッシさん、なるほどです。。m(__)m
ramrunさん、こんにちわ。。 こんな方法があるのですね・・わたくし「一つ進化しました」デヘヘ ^^ ゆきさん、またまたコードの差し替えです。m(__)m 前のに上書きしてネ。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, j As Integer, k As Integer
On Error GoTo Exit_sub
If Not Intersect(Target, Range("F:F")) Is Nothing Then
Application.EnableEvents = False
Me.Unprotect
For Each Target In Selection
With Target
If .Value = "" Then
With .Offset(, 1)
.Value = ""
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
End With
Else
k = WorksheetFunction.CountIf(Sheets("Sheet2").Range("A:A"), Target.Value)
If k = 1 Then
j = WorksheetFunction.Match(Target.Value, Sheets("Sheet2").Range("A:A"), 0)
Sheets("Sheet2").Cells(j, 2).Copy Target.Offset(, 1)
Else
j = WorksheetFunction.Match("その他出費", Sheets("Sheet2").Range("B:B"), 0)
Sheets("Sheet2").Cells(j, 2).Copy Target.Offset(, 1)
End If
End If
End With
Next Target
Me.Protect
Application.EnableEvents = True
End If
Exit Sub
Exit_sub:
MsgBox Err.Number & vbNewLine & Err.Description
Application.EnableEvents = True
End Sub
(kei)
無理やり使うなら、あらかじめ行番号を振っておくという方法もあるようです。
Private Sub Worksheet_Change(ByVal Target As Range) 1 On Error GoTo Exit_sub 2 ' 3 '処理 4 '
Exit_sub:
MsgBox Err.Number & vbNewLine & Err.Description & vbNewLine & Erl
Application.EnableEvents = True
End Sub
（ramrun）
難しくなってきて 頭が(~_~;)ついていけない…(~_~;) すみません ます keiさんの上のマクロと 2番目のマクロを 収支表だった シートに 貼り付けましたが 今は名前を 1 にしました なぜなら1月〜12月の同じシートが12枚あるので 1月なので 1 にしました そして F4に ガソリンと入れたら ｺﾝﾊﾟｲﾙｴﾗｰ 名前が適切ではありません と出て OKで閉じると Private Sub Worksheet_Change(ByVal Target As Range は青くなっています すみません (~_~;)
それと ウッシさんの ＞「エラーで終了した時」は何らかの原因でイベントマクロを中断終了した時に実行して下さい。
Sub エラーで終了した時()
Application.EnableEvents = True
End Sub
と書いてある意味が判らず…(~_~;) すみません エラーが出て中断してしまった時に どうやったらいいでしょうか
と同じく keiさんの ＞もし、なにも変化がなく「おかしー?」と思ったら、 最後に書いてある（ウッシさんのをパクッたもの m(__)m）で、「動かないときに使う」マクロを実行してネ。
の意味も判らず… 本当にごめんなさい 皆さんがせっかく教えて下さっているのに 申し訳ないです (-_-;) 判らないです (-_-;) それとウッシさん 保護はこの間の最後にコタさんが 作って下さったのが 打ち終わったら 自然に保護がかかるようになっていたので 保護はしていないです とすると ＞「jyunbbi」が二つあると思う思うので削除して下さい
はせずに このマクロのを入れてみればいいでしょうか
すみません つまり
Sub jyunbbi()
Application.EnableEvents = False
With Worksheets("収支表").Range("G:G")
.Parent.Unprotect
.Value = .Value
.Parent.Protect
End With
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Variant
Dim r As Range
Dim t As Range
Set t = Intersect(Target, Range("F:F"))
If t Is Nothing Then Exit Sub
Application.EnableEvents = False
Me.Unprotect
For Each r In t
With r
If .Value = "" Then
With .Offset(, 1)
.Value = ""
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
End With
Else
j = Application.Match(.Value, Sheets("Sheet2").Range("A:A"), 0)
If IsError(j) Then
j = Application.Match("それ以外", Sheets("Sheet2").Range("A:A"), 0)
End If
Sheets("Sheet2").Cells(j, 2).Copy Target.Offset(, 1)
End If
End With
Next
Me.Protect
Application.EnableEvents = True
End Sub
「エラーで終了した時」は何らかの原因でイベントマクロを中断終了した時に実行して下さい。
Sub エラーで終了した時()
Application.EnableEvents = True
End Sub
と↑ここまでを入れて それで ramrunさんの
Private Sub Worksheet_Change(ByVal Target As Range) 1 On Error GoTo Exit_sub 2 ' 3 '処理 4 '
Exit_sub:
MsgBox Err.Number & vbNewLine & Err.Description & vbNewLine & Erl
Application.EnableEvents = True
End Sub
を ウッシさんの 下に続けて入れる？でしょうか？(^_^;) 何か 皆さんの知識が凄すぎて m(__)m 私との差が凄いので 目玉が落ちそうです (~_~;)
すみません 私のしている事が おかしすぎると思いますが 宜しくお願い致します m(__)m
ゆきさん、ガンバ!! 仕事で楽をするために、あと一頑張りよ! 楽しなくっちゃ!^^
ウッシさんとわたしのブックを別にしておいてね。わけが分かんなくなるから。。
シート名を1月なので、「1」にしても問題ありません。 もう一度、最初からゆっくりやってみて、、
[1」そのシートのシートタブ→右クリック→コードの表示で、
そこにあるコードを一度全部消してから、下記のコードを張り付けてみて。
^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^^^^^^^
ただそれだけです。。
↓ココから
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, j As Integer, k As Integer
On Error GoTo Exit_sub
If Not Intersect(Target, Range("F:F")) Is Nothing Then
Application.EnableEvents = False
Me.Unprotect
For Each Target In Selection
With Target
If .Value = "" Then
With .Offset(, 1)
.Value = ""
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
End With
Else
k = WorksheetFunction.CountIf(Sheets("Sheet2").Range("A:A"), Target.Value)
If k = 1 Then
j = WorksheetFunction.Match(Target.Value, Sheets("Sheet2").Range("A:A"), 0)
Sheets("Sheet2").Cells(j, 2).Copy Target.Offset(, 1)
Else
j = WorksheetFunction.Match("その他出費", Sheets("Sheet2").Range("B:B"), 0)
Sheets("Sheet2").Cells(j, 2).Copy Target.Offset(, 1)
End If
End If
End With
Next Target
Me.Protect
Application.EnableEvents = True
End If
Exit Sub
Exit_sub:
MsgBox Err.Number & vbNewLine & Err.Description
Application.EnableEvents = True
End Sub
↑ココまで
「おかしー?」と思ったら、「動かないときに使う」マクロは、もう必要ありません。。 (kei)
こんばんは
みんなのコードを一つのブックにセットしてはダメですよ。 私のコードは ゆき さんが作ったブックを使いたいという要望が有ったので >「最初に私が作ったもの」のコピーブックで試して下さい。 とお断りしたはずです。
Sub jyunbbi()
Application.EnableEvents = False
With Worksheets("収支表").Range("G:G")
.Parent.Unprotect
.Value = .Value
.Parent.Protect
End With
Application.EnableEvents = True
End Sub
この「jyunbbi」は収支表シートのG列にVLookup の式が残っていたら値に変換します。 コードの中をクリックして、F5キーを押せば実行されます。
その後に、収支表シートのシートモジュールに下記コードを貼り付ければ終わりです。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Variant
Dim r As Range
Dim t As Range
Set t = Intersect(Target, Range("F:F"))
If t Is Nothing Then Exit Sub
Application.EnableEvents = False
Me.Unprotect
For Each r In t
With r
If .Value = "" Then
With .Offset(, 1)
.Value = ""
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
End With
Else
j = Application.Match(.Value, Sheets("Sheet2").Range("A:A"), 0)
If IsError(j) Then
j = Application.Match("それ以外", Sheets("Sheet2").Range("A:A"), 0)
End If
Sheets("Sheet2").Cells(j, 2).Copy Target.Offset(, 1)
End If
End With
Next
Me.Protect
Application.EnableEvents = True
End Sub
（ウッシ）
Private Sub Worksheet_Change() 〜 End Sub はセルで変更があったりすると勝手に実行されるんですが、こういうのをイベントといいます。
Private Sub Worksheet_Change() 〜 End Sub の中でセルを操作すると、またPrivate Sub Worksheet_Change() 〜 End Sub が実行されて、その処理の中でセルを操作すると... と永遠に繰り返しとなってしまうのはわかるでしょうか？
そこでセルを操作するところの前で Application.EnableEvents = False 、要するにイベントを無効にしておいて、セルの操作が終わったら Application.EnableEvents = True で有効に戻すというコードになっています。
ところがセルを操作している途中でエラーになって終了してしまうと、End Sub 手前にあるApplication.EnableEvents = True を実行せずに終わってしまい...
すると、次に試そうとしたときにはPrivate Sub Worksheet_Change() 〜 End Subが実行されない（無反応）なので、
Sub エラーで終了した時()
Application.EnableEvents = True
End Sub
を実行してみて〜 ということなんですが、私のは「エラーになったら Application.EnableEvents = True になるようにしといてあげたら？」という意味になります。
ただこれをやると、どの行でエラーになったかがわからない〜 というのが ウッシさん意見で、要するに長くなりましたが『やらなくてよい』ということです。
（ramrun）長々書いてたら衝突〜
ramrunさん、ありがとうございました。 未熟なわたしには、すばらしい「ツール」でした。 また教えてくださいネ ^^v お仕事に真面目な(kei)
keiさん すいません(-_-;) 1 のシートを右クリックしてコードを表示して、この間のを全て青くして選択してバックスペースで消して そこに 上のkeiさんのを貼り付けて バツで閉じて 1 というシートに戻り、 F４に電話代と打つと Ｇ４ は何も変化せず (~_~;) その隣のＨ４に元々 黄色が入れてあるのですが その色が パッと 消えます すいません… (-_-;) 色の設定を入れてあるsheet2 は一番最初に教えて頂いた数式はもう消していますが いいですよね う〜ん 何で 出来ないでしょう 何が違うんだろう。。。おかしいなーーー(-_-;) 次に ウッシさんのを ちょっと チョコレートでも食べて 頭を切り替えて やってみます すいません m(__)m
ゆきさん、チョコレートいいなぁ!! 数式は消しちゃって良いですよ。 一度そのブックを保存して、エクセルを終了させて、もう一度立ち上げてから入力してみて。。 明日の夜は、浴びるほどビールを飲むゾ(kei)
ウッシさんのをやってみたら F4に電話代 と入れたらG4は綺麗に 通信費 と出て 色も変わりました その他出費 も出ました 1個ずつ入力していくのは成功しました それで よし！！と思って、過去に作ってあった 別のブックの ガソリン代とか 電話代とかの いろんなものが打ってあったシートの F4:F77を コピーして この度のF4:F77に まとめて貼り付けましたら パッパッパッパッパッと
何回も G4:G77が つまり sheet2のB列 に入れてある 順番なのか いろんな項目のいろんな色に G4:G77まで まとめてですが 最初は 通信費の緑のセル となって それがG4:G77 の上から下まで 全部が パッパッパッパッパッ と 手品のように変わっていきまして 通信費の次は 雑費の赤 次は 交際費のピンク… と何回も G4:G77の上から下までまとめて 同じものに次々と変わり続け そして どうなるのかと観察していましたら 最後は sheet2のB列の105：111 を入院保険にしていたのですが 入院保険 でブルーに G4:G77 全部が 入院保険になりました sheet2 は AとBの列は ずっと入力していったら 今の段階では119行目になりましたが これからも どんどん増えそうですが これは何行目まで 増えても 関係ないですか？ 大変すみません 何が私おかしいでしょうかm(__)m すみませんが何卒宜しくお願い致します m(__)m
こんにちは
済みません、一箇所、間違えてました。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Variant
Dim r As Range
Dim t As Range
Set t = Intersect(Target, Range("F:F"))
If t Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In t
With r
If .Value = "" Then
With .Offset(, 1)
.Value = ""
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
End With
Else
j = Application.Match(.Value, Sheets("Sheet2").Range("A:A"), 0)
If IsError(j) Then
j = Application.Match("それ以外", Sheets("Sheet2").Range("A:A"), 0)
End If
Sheets("Sheet2").Cells(j, 2).Copy .Offset(, 1)
End If
End With
Next
Application.EnableEvents = True
End Sub
差し替えて下さい。
（ウッシ）
出来ました ありがとうございます 最初にテスト入力してみたら、綺麗に昔のものが まとめて貼り付けれました しかし ひとつでも F を消すと、例えばF15とかを 消してみると interior ｸﾗｽのcolirindexﾌﾟﾛﾊﾟﾃｨを設定できません と出て ﾃﾞﾊﾞｯｸの所を押すと Interior.color Index=XINone の所が 黄色くなっていたので あれ 又保護がかかったかなと 見てみたら 保護が自然に かかっていました(^_^;)
なので 又最初から新しいのを作り直して調べましたら マクロのコードを 入れると 保護が 自然にかかって 後から Fの修正をしたりすると 上のエラーが出てしまいます (^_^;)すみません
F列の例えば F15 を削除する前に 保護を外すしてから F15を削除すると エラーが出ずに 綺麗に出来ます すみません 何が間違っていますでしょうか(~_~;) 本当に すみません m(__)m 宜しくお願い致します m(__)m
こんばんは
また保護を付け外しする前のコード直してました。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Variant
Dim r As Range
Dim t As Range
Set t = Intersect(Target, Range("F:F"))
If t Is Nothing Then Exit Sub
Application.EnableEvents = False
Me.Unprotect
For Each r In t
With r
If .Value = "" Then
With .Offset(, 1)
.Value = ""
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
End With
Else
j = Application.Match(.Value, Sheets("Sheet2").Range("A:A"), 0)
If IsError(j) Then
j = Application.Match("それ以外", Sheets("Sheet2").Range("A:A"), 0)
End If
Sheets("Sheet2").Cells(j, 2).Copy .Offset(, 1)
End If
End With
Next
Me.Protect
Application.EnableEvents = True
End Sub
コード差し替えて一旦ブックを保存終了するか、
Sub エラーで終了した時()
Application.EnableEvents = True
End Sub
を標準モジュールに入れて、コードの中をクリックしてからF5キーで実行して下さい。
エラーで中断終了したままだとイベントが発生しないと思いますので。
（ウッシ）
ウッシさん 凄いです 出来ました！！
すみません 確認させておいてください。
一番上で教えて頂いた
Sub jyunbbi()
Application.EnableEvents = False
With Worksheets("収支表").Range("G:G")
.Parent.Unprotect
.Value = .Value
.Parent.Protect
End With
Application.EnableEvents = True
End Sub
は入れずに 結局 入れるのは
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Variant
Dim r As Range
Dim t As Range
Set t = Intersect(Target, Range("F:F"))
If t Is Nothing Then Exit Sub
Application.EnableEvents = False
Me.Unprotect
For Each r In t
With r
If .Value = "" Then
With .Offset(, 1)
.Value = ""
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
End With
Else
j = Application.Match(.Value, Sheets("Sheet2").Range("A:A"), 0)
If IsError(j) Then
j = Application.Match("それ以外", Sheets("Sheet2").Range("A:A"), 0)
End If
Sheets("Sheet2").Cells(j, 2).Copy .Offset(, 1)
End If
End With
Next
Me.Protect
Application.EnableEvents = True
End Sub
↑ここまでを入れておいてから 挿入→標準モジュール で
そこに
Sub エラーで終了した時()
Application.EnableEvents = True
End Sub
を入れて F5を押す
で いいでしょうか？ すみません 宜しくお願い致します m(__)m
おはようございます。
Sub jyunbbi() はG列にVLookup 等の計算式が残っている場合に実行します。 何も式がセットされていなければ実行する必要は無いです。
Sub エラーで終了した時() は Private Sub Worksheet_Change(ByVal Target As Range) が何らかの原因で中断し、そのまま終了させた時に実行します。 その際にコードのどこで中断したか、どんなエラーメッセージか記録しておけば再質問する時に役立つ情報になります。
（ウッシ）
みなさん、おはよーございます。 ゆきさん、出来たようですね。良かった ^^ 昨夜は酔いつぶれていました。。 (kei)
削除しても エラーは出なくなり 綺麗に出来るようになりました (^_^) ありがとうございます m(__)m それで 一つ聞きたいのですが 打ち終わってから 削除して 次に 上の矢印の「元に戻る 」 を押そうと思っても グレーになっていて押せないのは 元に戻る ボタンは 効かない？という事になりますでしょうか？ すみませんが 教えて下さい 宜しくお願い致します m(__)m
こんばんは このようなイベントマクロの場合、一旦処理が走ると「元に戻る」事は出来ません。 セルをクリアする場合は本当にクリアして良いかメッセージを出すとこんな感じです。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Variant
Dim r As Range
Dim t As Range
Set t = Intersect(Target, Range("F:F"))
If t Is Nothing Then Exit Sub
If WorksheetFunction.CountBlank(t) > 0 Then
If MsgBox("F列のセルがクリアされます。宜しいですか？", 49) = vbCancel Then
Application.EnableEvents = False
Me.Unprotect
Application.Undo
Me.Protect
Application.EnableEvents = True
Exit Sub
End If
End If
Application.EnableEvents = False
Me.Unprotect
For Each r In t
With r
If .Value = "" Then
With .Offset(, 1)
.Value = ""
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
End With
Else
j = Application.Match(.Value, Sheets("Sheet2").Range("A:A"), 0)
If IsError(j) Then
j = Application.Match("それ以外", Sheets("Sheet2").Range("A:A"), 0)
End If
Sheets("Sheet2").Cells(j, 2).Copy .Offset(, 1)
End If
End With
Next
Columns("F:F").Locked = False
Me.Protect
Application.EnableEvents = True
End Sub
（ウッシ）
ウッシさん ありがとうございました。元に戻れない 警告みたいなのが出るんですね〜〜 凄いですねーー。 ウッシさん 本当にお世話になり どうも ありがとうございました(^_^) keiさん ramrunさんにも 大変にお世話になりました m(__)m ウッシさん 理解力のない私相手に 最後まで教えて頂いて 本当に どうもありがとうございました m(__)m
もう見て頂けるか わかりませんが すみません ウッシさん上のを入れようと思いますが そうすると
＞Sub エラーで終了した時()
Application.EnableEvents = True
End Sub
を標準モジュールに入れて、コードの中をクリックしてからF5キーで実行して下さい
これは 入れておいた方が いいでしょうか？
おはようございます。
別のブックにしたのなら入れておいて下さい。
大体のエラーを本コードで回避出来るようになったら、keiさんのコードにあったように
On Error GoTo Exit_sub
〜
Exit Sub
Exit_sub:
MsgBox Err.Number & vbNewLine & Err.Description
Application.EnableEvents = True
End Sub
を本コードに入れてあげるといいです。
（ウッシ）
＞大体のエラーを本コードで回避出来るようになったら、keiさんのコードにあったように
On Error GoTo Exit_sub
〜
Exit Sub
Exit_sub:
MsgBox Err.Number & vbNewLine & Err.Description
Application.EnableEvents = True
End Sub
を本コードに入れてあげるといいです
の意味が すみません 判らないのですが(^_^;) という事は
On Error GoTo Exit_sub
〜
Exit Sub
Exit_sub:
MsgBox Err.Number & vbNewLine & Err.Description
Application.EnableEvents = True
End Sub
を
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Variant
Dim r As Range
Dim t As Range
Set t = Intersect(Target, Range("F:F"))
If t Is Nothing Then Exit Sub
If WorksheetFunction.CountBlank(t) > 0 Then
If MsgBox("F列のセルがクリアされます。宜しいですか？", 49) = vbCancel Then
Application.EnableEvents = False
Me.Unprotect
Application.Undo
Me.Protect
Application.EnableEvents = True
Exit Sub
End If
End If
Application.EnableEvents = False
Me.Unprotect
For Each r In t
With r
If .Value = "" Then
With .Offset(, 1)
.Value = ""
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
End With
Else
j = Application.Match(.Value, Sheets("Sheet2").Range("A:A"), 0)
If IsError(j) Then
j = Application.Match("それ以外", Sheets("Sheet2").Range("A:A"), 0)
End If
Sheets("Sheet2").Cells(j, 2).Copy .Offset(, 1)
End If
End With
Next
Columns("F:F").Locked = False
Me.Protect
Application.EnableEvents = True
End Sub
の下に
On Error GoTo Exit_sub
〜
Exit Sub
Exit_sub:
MsgBox Err.Number & vbNewLine & Err.Description
Application.EnableEvents = True
End Sub
を貼り付ければいいという事でしょうか？ すみません 宜しくお願い致しますm(__)m
こんにちは keiさんのコードを見れば分かると思います。 そろそろコードを読むようにした方がいいですよ。 こうしたいというゆきさんの要求を満たすようにコードを書いてるつもりなので、どこが何をしてるコードなのか想像もつくと思うのですが？
分からない部分、例えば「Intersect」とかが有ったら、その単語の部分をクリックして F1キーを押すと ヘルプが出ます。（ヘルプがインストールしてなかったらインストールしておいた方がいいです。）
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Variant
Dim r As Range
Dim t As Range
On Error GoTo Exit_sub
Set t = Intersect(Target, Range("F:F"))
If t Is Nothing Then Exit Sub
If WorksheetFunction.CountBlank(t) > 0 Then
If MsgBox("F列のセルがクリアされます。宜しいですか？", 49) = vbCancel Then
Application.EnableEvents = False
Me.Unprotect
Application.Undo
Me.Protect
Application.EnableEvents = True
Exit Sub
End If
End If
Application.EnableEvents = False
Me.Unprotect
For Each r In t
With r
If .Value = "" Then
With .Offset(, 1)
.Value = ""
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
End With
Else
j = Application.Match(.Value, Sheets("Sheet2").Range("A:A"), 0)
If IsError(j) Then
j = Application.Match("それ以外", Sheets("Sheet2").Range("A:A"), 0)
End If
Sheets("Sheet2").Cells(j, 2).Copy .Offset(, 1)
End If
End With
Next
Columns("F:F").Locked = False
Me.Protect
Application.EnableEvents = True
Exit Sub
Exit_sub:
MsgBox Err.Number & vbNewLine & Err.Description
Application.EnableEvents = True
End Sub
（ウッシ）
ウッシさん 大変にお世話になりました 本当にありがとうございましたm(__)m コードを読む というのは 私にとって とても難しい事ですが 努力してみます m(__)m 本当にお世話になりました ウッシさん どうもありがとうございました (*^_^*)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.