こんばんは、watabe007さん。

質問

961awaawaです。
＞シートモジュールに貼り付けてお試しください。
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If Intersect(.Cells, Range("L:M")) Is Nothing Then Exit Sub
If .Row < 3 Or .Value = "" Then Exit Sub
If Not IsNumeric(.Value) Then Exit Sub
.Offset(, 3).Value = Cells(.Row, .Value).Value
End With
End Sub
というソースを作って頂いたのですが、既に各sheetにprivate sub からなるソースが入ってましてコンパイルエラー(名前が適切ではありません Worksheet_Change)となります。他に方法等頂けましたらありがたいです。

回答No.3

watabe007 · ベストアンサー

>標準モジュールで12枚のsheetを指定する形にして、
>いつセルU、セルV、セルW6に数字を入れてもセルY、セルZ、セルAAに
>数字記号がコピーされる形が希望なんです。
Sub Test()
　　Dim SourceRng As Range
　　Set SourceRng = Range("C6:L6")
　　If Intersect(ActiveCell, Range("U:W")) Is Nothing Then
　　　　MsgBox "U、V、W、何れかのセルを選択して実行してください。", 48
　　　　Exit Sub
　　End If
　　If Not IsNumeric(ActiveCell.Value) Or ActiveCell.Value = "" Then Exit Sub
　　ActiveCell.Offset(, 4).Value = SourceRng.Item(ActiveCell.Value)
End Sub

お礼

この場合はsheetセレクト等が必要になりますか？
また、P3=OFFSET(A3,0,M3-1)
の0の部分を空白にしたいのですがどのようにしたらよろしいでしょうか？

回答No.2

watabe007

二つのWorksheet_Changeを一つにしました。
お試しください。
Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim myC As Variant
　　With Target
　　　　If .Count > 1 Then Exit Sub
　　　　If .Value = "" Then Exit Sub
　　　　If Not Intersect(.Cells, Range("L:M")) Is Nothing Then
　　　　　　If .Row < 3 Or Not IsNumeric(.Value) Then Exit Sub
　　　　　　.Offset(, 3).Value = Cells(.Row, .Value).Value
　　　　ElseIf .Row >= 6 And .Column = 14 Then
　　　　　　myC = Application.Match(.Value, Cells(.Row, "C").Resize(, 10), 0)
　　　　　　If Not IsError(myC) Then
　　　　　　　　Cells(.Row, "B").Offset(, myC).Interior.Color = vbYellow
　　　　　　　　Cells(.Row, "N").Resize(, 6).Borders.LineStyle = xlContinuous
　　　　　　　　Cells(.Row, "N").Resize(, 6).HorizontalAlignment = xlCenter
　　　　　　　　Cells(.Row, "N").Offset(, (myC + 1) \ 2).Value = "×"
　　　　　　End If
　　　　End If
　　End With
End Sub

お礼

こんばんはwatabe007さん。せっかく作って頂いたのに質問を訂正させてください。
0、1、2、3、4、5、6、7、8、9の記号のいずれかがセルC6～L6の各セルにダブルことなく適当に入ってます。U6、V6、W6に1～10までのどれかを入れて、

(1)U6に1が入ると、一番目のC6に入った記号がY6にコピーされ

(2)V6に5が入ると、C6から5番目のG6に入った記号がZ6にコピーされ

(3)W6に7が入ると、C6から7番目のI6に入った記号がAA6にコピーされる
という仕組みにしたいです。

今は例えで6行目を使いましたがマクロボタンを押す度に、7行目、8行目.....と開拓？できるようにしたいです。U6V6W6に入れる数字は自分で選択したいです。
標準モジュールで12枚のsheetを指定する形にして、いつセルU、セルV、セルW6に数字を入れてもセルY、セルZ、セルAAに数字記号がコピーされる形が希望なんです。

説明が下手でスミマセン。

回答No.1

watabe007

こんにちは
>(名前が適切ではありません Worksheet_Change)
既にPrivate Sub Worksheet_Change(ByVal Target As Range)が
書かれているのですね、そちらのコードを全て提示していただけませんか

お礼

こんばんはwatabe007さん。いつもご協力感謝します。
以前作って頂いたソースになります。
＞Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim myC As Variant
　　With Target
　　　　If .Count > 1 Then Exit Sub
　　　　If .Value = "" Then Exit Sub
　　　　If .Row < 6 Or .Column <> 14 Then Exit Sub
　　　　myC = Application.Match(.Value, Cells(.Row, "C").Resize(, 10), 0)
　　　　If Not IsError(myC) Then
　　　　　　Cells(.Row, "B").Offset(, myC).Interior.Color = vbYellow
　　　　　　Cells(.Row, "N").Resize(, 6).Borders.LineStyle = xlContinuous
　　　　　　Cells(.Row, "N").Resize(, 6).HorizontalAlignment = xlCenter
　　　　　　Cells(.Row, "N").Offset(, (myC + 1) \ 2).Value = "×"
　　　　End If
　　End With
End Sub

このソースが12枚のsheetに入ってます。よろしくお願いいたします。