Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
12374 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【10766】ご教示お願いします。 馬詰膳次郎 04/2/13(金) 8:58 質問
【10767】Re:ご教示お願いします。 Asaki 04/2/13(金) 10:08 回答
【10769】Re:ありがとうございます。 馬詰膳次郎 04/2/13(金) 12:29 質問
【10770】Re:ありがとうございます。 Asaki 04/2/13(金) 12:45 回答
【10772】Re:エラー1004は直りました。 馬詰膳次郎 04/2/13(金) 14:15 発言
【10773】Re:エラー1004は直りました。 Asaki 04/2/13(金) 14:35 回答
【10777】Re:説明不足でした。 馬詰膳次郎 04/2/13(金) 15:44 発言
【10778】Re:説明不足でした。 Asaki 04/2/13(金) 15:57 回答
【10781】Re:説明不足でした。 馬詰膳次郎 04/2/13(金) 16:30 発言
【10783】Re:説明不足でした。 Asaki 04/2/13(金) 16:40 回答
【10838】Re:変わりません。 馬詰膳次郎 04/2/16(月) 9:57 発言
【10840】Re:変わりません。 Asaki 04/2/16(月) 10:06 回答
【10846】Re:列番号は共に一致してます。 馬詰膳次郎 04/2/16(月) 11:22 発言
【10848】Re:列番号は共に一致してます。 Asaki 04/2/16(月) 11:26 回答
【10851】Re:確認ですが。 馬詰膳次郎 04/2/16(月) 12:22 発言
【10852】Re:確認ですが。 Asaki 04/2/16(月) 12:32 回答
【10854】Re:またまたエラーが。。。。 馬詰膳次郎 04/2/16(月) 13:25 発言
【10855】Re:またまたエラーが。。。。 Asaki 04/2/16(月) 13:33 回答
【10856】Re:御指導ありがとうございました。 馬詰膳次郎 04/2/16(月) 13:53 お礼
【10774】Re:エラー1004は直りました。 Jaka 04/2/13(金) 14:57 回答
【10766】ご教示お願いします。
質問  馬詰膳次郎  - 04/2/13(金) 8:58 -
引用なし
パスワード
   はじめまして。馬詰と申します。

１をいれて伊藤とか、２をいれて鈴木、３をいれて間宮というように、
Sheet1に名前一覧があって、Sheet2に番号を入れると名前になるようになっています。
具体的には次のような、マクロが入っています。
Private Sub TextBox1_Change()

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim MyRow As Long, MyEnd As Long
　　Dim Ws As Worksheet
　　Application.EnableEvents = False
　　If Target.Count <> 1 Then Exit Sub
　　MyRow = Val(Target.Value)
　　Set Ws = Worksheets("名前")
　　MyEnd = Ws.Cells(65536, Target.Column).End(xlUp).Row
　　If MyEnd = 1 Then Exit Sub
　　If MyRow > 0 And MyRow <= MyEnd Then
　　　　Target.Value = Ws.Cells(MyRow, Target.Column).Value
　　End If
　　If Application.WorksheetFunction.CountIf(Target.EntireColumn, Target.Value) > 2300 Then
　　　　MsgBox ("?")
　　　　Target.Value = ""
　　End If
　　Application.EnableEvents = True
End Sub

しかし、別のデータから番号を貼り付けた場合、変わるようにもしたいのです。
どのような、マクロを付け加えればよいでしょうか？
【10767】Re:ご教示お願いします。
回答  Asaki  - 04/2/13(金) 10:08 -
引用なし
パスワード
   こんにちは。

>別のデータから番号を貼り付けた場合、変わるようにもしたいのです
コピー&ペースト という意味ですよね？
今の状態では変わりませんか？上手くいくように思うのですが。

あと、内容を理解するついでにちょっとコードをいじってみました。
参考程度に。

Private Sub Worksheet_Change(ByVal Target As Range)

　　Dim str　　　　 As String

　　If Target.Count <> 1 Then Exit Sub
　　str = Worksheets("名前").Cells(Val(Target.Value), Target.Column).Value
　　With Application
　　　　.EnableEvents = False
　　　　Target.Value = str
　　　　.EnableEvents = True
　　End With

End Sub
【10769】Re:ありがとうございます。
質問  馬詰膳次郎  - 04/2/13(金) 12:29 -
引用なし
パスワード
   やってはみましたが、番号は番号のままでした。ペーストする際に「全て」貼り付けでは
いけないのでしょうか？

それから、下のコードですが、

入力を間違えた場合、削除したりしますよね。すると、

実行時エラー'1004'
アプリケーション定義またはオブジェクト定義のエラーです。

となります。


Private Sub Worksheet_Change(ByVal Target As Range)

　　Dim str　　　　 As String

　　If Target.Count <> 1 Then Exit Sub
　　str = Worksheets("名前").Cells(Val(Target.Value), Target.Column).Value
　　With Application
　　　　.EnableEvents = False
　　　　Target.Value = str
　　　　.EnableEvents = True
　　End With

End Sub

どうすればよいのでしょうか？
【10770】Re:ありがとうございます。
回答  Asaki  - 04/2/13(金) 12:45 -
引用なし
パスワード
   >実行時エラー'1004'
回避のため、1行追加しました
Private Sub Worksheet_Change(ByVal Target As Range)

　　Dim str　　　　 As String

　　If Target.Count <> 1 Then Exit Sub
　　If Val(Target.Value) = 0 Then Exit Sub　　　'←追加
　　str = Worksheets("名前").Cells(Val(Target.Value), Target.Column).Value
　　With Application
　　　　.EnableEvents = False
　　　　Target.Value = str
　　　　.EnableEvents = True
　　End With

End Sub

>番号は番号のままでした。ペーストする際に「全て」貼り付けではいけないのでしょうか？
いえ、それで大丈夫だと思いますよ。
こちらでは、ちゃんと動きます。
Excelのバージョンは何ですか？
Changeイベントは、バージョンによって動作が違うと聞いたような聞かないような。。。
【10772】Re:エラー1004は直りました。
発言  馬詰膳次郎  - 04/2/13(金) 14:15 -
引用なし
パスワード
   ありがとうございました。

私のは、2002バージョンです。

やはり無理なのでしょうか？
【10773】Re:エラー1004は直りました。
回答  Asaki  - 04/2/13(金) 14:35 -
引用なし
パスワード
   貼り付けた数字が全角だったりはしませんよね？
こちらは2000ですが、半角数字ならコピペでもちゃんと動作します。

取り敢えず、val() をやめて、1行、数値の判定を追加しました。
Private Sub Worksheet_Change(ByVal Target As Range)

　　Dim str　　　　 As String

　　If Target.Count <> 1 Then Exit Sub
　　If Not IsNumeric(Target.Value) Then Exit Sub　　'←追加
　　If CLng(Target.Value) = 0 Then Exit Sub
　　str = Worksheets("名前").Cells(CLng(Target.Value), Target.Column).Value
　　With Application
　　　　.EnableEvents = False
　　　　Target.Value = str
　　　　.EnableEvents = True
　　End With

End Sub

また、
>If Target.Count <> 1 Then Exit Sub
の行にブレークポイントを設定して、F8キー押下でステップ実行してみてください。
どこで上手くいかないか、こちらではちょっと判りません。
【10774】Re:エラー1004は直りました。
回答  Jaka  - 04/2/13(金) 14:57 -
引用なし
パスワード
   こんにちは。
こんな感じじゃダメでしょうか？

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
　　Dim trg As Range
　　Application.EnableEvents = False
　　For Each trg In Target
　　　　If trg.Value <> "0" Then
　　　　　 trg.Value = "WW"　　'この辺適当に変えてください。
　　　　End If
　　Next
　　Application.EnableEvents = True
End Sub
【10777】Re:説明不足でした。
発言  馬詰膳次郎  - 04/2/13(金) 15:44 -
引用なし
パスワード
   もうしわけありません。説明不足でした。
一個一個コピペすれば、全然問題ないのですが、

ある程度まとまって例えばA2:J2300という風にまとめて、
コピペする場合は、だめですよね？
【10778】Re:説明不足でした。
回答  Asaki  - 04/2/13(金) 15:57 -
引用なし
パスワード
   >ある程度まとまって例えばA2:J2300という風にまとめて、
>コピペする場合は、だめですよね？

いや、だって、
>If Target.Count <> 1 Then Exit Sub
と書いてありましたから。

Jaka さんのコードなら、希望どおりの動作になるのではありませんか？
【10781】Re:説明不足でした。
発言  馬詰膳次郎  - 04/2/13(金) 16:30 -
引用なし
パスワード
   If Target.Count > 1するところでした。
勉強不足で申し訳ありません。

複数範囲のコピペは、出来るのでしょうか？
【10783】Re:説明不足でした。
回答  Asaki  - 04/2/13(金) 16:40 -
引用なし
パスワード
   Jaka さんとほとんど同じですが、↓では如何でしょうか？

Private Sub Worksheet_Change(ByVal Target As Range)

　　Dim str　　　　 As String
　　Dim rng　　　　 As Range

　　Application.EnableEvents = False
　　Application.ScreenUpdating = False
　　With Worksheets("名前")
　　　　For Each rng In Target
　　　　　　If IsNumeric(rng.Value) Then
　　　　　　　　str = .Cells(CLng(rng.Value), rng.Column).Value
　　　　　　　　rng.Value = str
　　　　　　End If
　　　　Next rng
　　End With
　　Application.EnableEvents = True
　　Application.ScreenUpdating = True

End Sub
【10838】Re:変わりません。
発言  馬詰膳次郎  - 04/2/16(月) 9:57 -
引用なし
パスワード
   返事が遅くなって申し訳ありません。
まとめてコピペしても、番号は番号のままでした。
【10840】Re:変わりません。
回答  Asaki  - 04/2/16(月) 10:06 -
引用なし
パスワード
   こんにちは。

こちらは、一番最初にupされたコードから、動作を判断しています。
>Target.Value = Ws.Cells(MyRow, Target.Column).Value
という1文がありましたので、
伊藤とか、鈴木とかのリストが入力されている列番号に一致している列が
Targetになっていない場合は何もしません。
リストがA列にある場合、↓で如何でしょうか？

>str = .Cells(CLng(rng.Value), rng.Column).Value
 ↓
str = .Cells(CLng(rng.Value), 1).Value
【10846】Re:列番号は共に一致してます。
発言  馬詰膳次郎  - 04/2/16(月) 11:22 -
引用なし
パスワード
   名前が登録されている列はF列を基準として、名列がJ列まで以下のように、

　　　F　　　　G・・・・・・・　J
１　佐藤　　　北・・・・・・・松尾
２　鈴木　　　高橋・・・・・・生天目　　　
３　安藤　　　持月・・・・・・國分
４　高梨　　　京谷・・・・・・柳沼
５　権藤　　　近藤・・・・・・佐久間
６　三波　　　蜂須賀・・・・・柴田
・　　・　　　　・　　　　　　　・　　　　
・　　・　　　　・　　　　　　　・　　
・　　・　　　　・　　　　　　　・　

になってます。
番号を入力して名前をかえるSheetもFからJまでの、入力となってます。
なので、名前の列が合わないということはないと思います。
【10848】Re:列番号は共に一致してます。
回答  Asaki  - 04/2/16(月) 11:26 -
引用なし
パスワード
   では、コードの先頭にブレークポイントを設定してから、動かしてみてください。
F8でステップ実行しますので、どのような処理が行われているかを確認してください。

また、イベント自体が動作していない可能性がありますので、
VBEでイミディエイトウィンドウを表示し(Ctrl+G)、
Application.EnableEvents = True
と入力して、Enterを押下して、確実にイベントが動作する状態にしてからのほうが良いかもしれません。
【10851】Re:確認ですが。
発言  馬詰膳次郎  - 04/2/16(月) 12:22 -
引用なし
パスワード
   今下のようなコードになってます。

Private Sub Worksheet_Change(ByVal Target As Range)

　　Dim str　　　　 As String

　　If Target.Count > 1 Then Exit Sub
　　If Val(Target.Value) = 0 Then Exit Sub
　　str = Worksheets("名前").Cells(Val(Target.Value), Target.Column).Value
　　With Application
　　　　.EnableEvents = False
　　　　Target.Value = str
　　　　.EnableEvents = True
　　End With

End Sub

それで、まとめて番号をコピペした後、普通に1つずついれても、名前に変わりますので
イベント自体は動いてはいると思いますが。。。。
【10852】Re:確認ですが。
回答  Asaki  - 04/2/16(月) 12:32 -
引用なし
パスワード
   ご提示のコードは
Targetが複数セルになる場合は、上手く動かないかと思います。
というより、
>If Target.Count > 1 Then Exit Sub
複数セルなら処理しない、になってます。

10783 のコードではダメでしょうか？
【10854】Re:またまたエラーが。。。。
発言  馬詰膳次郎  - 04/2/16(月) 13:25 -
引用なし
パスワード
   １０７８３コードで行きますと、実行時エラー1004が出て削除できません。
また、同じ実行時エラー1004は複数のコピペでも出てしまいます。
【10855】Re:またまたエラーが。。。。
回答  Asaki  - 04/2/16(月) 13:33 -
引用なし
パスワード
   >If IsNumeric(rng.Value) Then
 ↓
If Val(rng.Value) > 0 Then

では如何でしょうか？
【10856】Re:御指導ありがとうございました。
お礼  馬詰膳次郎  - 04/2/16(月) 13:53 -
引用なし
パスワード
   Asaki様

希望どおりのイベントが実現いたしました。
長い間のご指導ありがとうございました。

馬詰膳次郎

PS：また、お世話になることがあるかと思います。
その時は、またよろしくお願いします。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
12374 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free