特定の文字以外を入力すると別シートに表記する方法
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim StrRow As Long
Dim TgtCol As Long
Dim MaxRow As Long
Dim ChgRow As Long
Dim PutSh1 As Worksheet
Dim PutSh2 As Worksheet
Dim PutSh3 As Worksheet
Dim PutCol As Long
Dim PutRow As Long
Dim ChgRng1 As Range
Dim ChgRng2 As Range
Dim ChgRng3 As Range
StrRow = 5
MaxRow = 35
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
Set PutSh1 = ThisWorkbook.Sheets("Sheet2")
Set PutSh2 = ThisWorkbook.Sheets("Sheet3")
Set PutSh3 = ThisWorkbook.Sheets("Sheet4")
With ThisWorkbook.Sheets("Sheet1")
Set ChgRng1 = Range(.Cells(StrRow, 3), .Cells(MaxRow, 3)) 'C列
Set ChgRng2 = Range(.Cells(StrRow, 5), .Cells(MaxRow, 5)) 'E列
Set ChgRng3 = Range(.Cells(StrRow, 7), .Cells(MaxRow, 7)) 'G列
End With
ChgRow = Target.Row
If Not Intersect(Target, ChgRng1) Is Nothing Then
Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + 1
DataPut PutSh1, ChgRow, Target.Value
End If
If Not Intersect(Target, ChgRng2) Is Nothing Then
Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + 1
DataPut PutSh2, ChgRow, Target.Value
End If
If Not Intersect(Target, ChgRng3) Is Nothing Then
Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + 1
DataPut PutSh3, ChgRow, Target.Value
End If
End Sub
以前質問させて頂いた内容で追加の質問です。
Sheet1の指定したセルに「ー（ハイフン）」の文字がある時は、Sheet2〜4に転送（表記）しない方法を追加する場合はどの様にすれば宜しいでしょうか？
お礼
ありがとうございました。 質問後も教えていただいたのと近いものまでは たどり着きましたが、 うまくいかず。 教えていただいたように修正したらうまくいきました。