このマクロを訂正できますでしょうか？

質問

private sub worksheet_change(byval Target as excel.range)
dim h as range
on error resume next
for each h in application.intersect(target, range("C:C"))
if h <> "" then
cells(h.row, "A").formular1c1 = "=COUNTA(R1C[2]:RC[2])"
cells(h.row, "B") = date
else
h.offset(0,-2).resize(1, 2).clearcontents
end if
next
end sub

このマクロはC列に入力すると、A列に番号、B列に入力した日付が入力されるマクロです。
現状の問題として、

(1)A列に計算式が入ってしまうこと
(2)C３セルに品名という項目が入っているために、C４から品目を入力していく上で、最初の割り振られるNOが２番からになってしまう

の２つの問題が生じています。これを解決するにはどのように訂正すればよいかご教授いただければ助かります。

回答No.6

tom04 · ベストアンサー

No.2・5です！
何度もごめんなさい。

日付の表示形式の件で・・・

＞With Cells(i, 2)
＞.NumberFormatLocal = "yyyy/m/d"
＞.Value = Date
＞End With

の4行を単純に
＞Cells(i, 2).Value = Date
とだけにしてください。

ではでは・・・m(_ _)m

お礼

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns(3)) Is Nothing Or Selection.Count <> 1 Then Exit Sub
Dim i As Long
i = Target.Row
Application.ScreenUpdating = False
If i > 3 Then
If Target = "" Then
Range(Cells(i, 1), Cells(i, 2)).ClearContents
Else
Cells(i, 2).Value = Date
End If
End If
For i = 4 To Cells(Rows.Count, 2).End(xlUp).Row
If Cells(i, 2) <> "" Then
Cells(i, 1) = WorksheetFunction.Count(Range(Cells(4, 2), Cells(i, 2)))
End If
Next i
Application.ScreenUpdating = True
End Sub

完璧です。tom04さん、私はとても嬉しいです。こんなに早くご回答頂ける人は
今までで初めてでした。ありがとうございました。そして皆様にも感謝の気持ちでいっぱいです。
ありがとうございましたm(_ _)m

回答No.5

tom04

No.2です！
補足を読ませていただきました。
少しコードに手を加えています。

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns(3)) Is Nothing Or Selection.Count <> 1 Then Exit Sub
Dim i As Long
i = Target.Row
Application.ScreenUpdating = False
If i > 3 Then
If Target = "" Then
Range(Cells(i, 1), Cells(i, 2)).ClearContents
Else
With Cells(i, 2)
.NumberFormatLocal = "yyyy/m/d"
.Value = Date
End With
End If
End If
For i = 4 To Cells(Rows.Count, 2).End(xlUp).Row
If Cells(i, 2) <> "" Then
Cells(i, 1) = WorksheetFunction.Count(Range(Cells(4, 2), Cells(i, 2)))
End If
Next i
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか？

※　ご希望通りの動きにならなかったらごめんなさいね。m(_ _)m

お礼

素早いご回答、非常に感謝いたします！
完璧です。希望どうりのコードを教えて頂き本当に嬉しいです。
皆様の知恵で何とかなりそうです。ありがとうございました！！

補足

申し訳ないです。補足の補足を後からつけたのでごめんなさい。
日付の形式がやはり "yyyy/m/d"年に固定されてしまうので、
これを自由に変えた後に入力してその形式で表示されれば良いです。
例えば私の提示したコードは、B列の表示形式を変えたらその変えた形式に
対応して表示されるようになります。
無理をいって本当にごめんなさいm(_ _)m

回答No.4

keithin

Ａ列に数式を入れたくないのがご希望なのでしたら，次のようにします

private sub worksheet_change(byval Target as excel.range)
　dim h as range
　on error resume next
　for each h in application.intersect(target, range("C4:C65536"))
　　if h <> "" then
　　　cells(h.row, "A") = application.max(range("A4:A65536)) + 1
　　　cells(h.row, "B") = date
　　else
　　　h.offset(0,-2).resize(1, 2).clearcontents
　　end if
　next
end sub

言わずもがなですが数式でなくしたので，番号を連番で通す機能とか，番号の自動更新の機能はなくなりました。

お礼

ご回答ありがとうございます。
コンパイルエラーになりました、申し訳ないです。

補足

Private Sub worksheet_change(ByVal Target As Excel.Range)
Dim h As Range
On Error Resume Next
For Each h In Application.Intersect(Target, Range("C:C"))
If h <> "" Then
Cells(h.Row, "A").FormulaR1C1 = "=COUNTA(R1C[2]:RC[2])-1"
Cells(h.Row, "B") = Date
Else
h.Offset(0, -2).Resize(1, 2).ClearContents
End If
Next
End Sub

皆様のご意見で自分の希望のコードに一歩近づきました。
あとはA列に式が表示されずに、上のコードの機能が損なわれなかたら言うことないです。

回答No.3

mar00

以下のように修正してみて下さい。
Private Sub worksheet_change(ByVal Target As Excel.Range)
Dim h As Range
On Error Resume Next
For Each h In Application.Intersect(Target, Range("C:C"))
If h <> "" Then
Cells(h.Row, "A").FormulaR1C1 = "=COUNTA(R1C[2]:RC[2])-1" 'ここを修正
Cells(h.Row, "A") = Cells(h.Row, "A") 'ここを追加
Cells(h.Row, "B") = Date
Else
h.Offset(0, -2).Resize(1, 2).ClearContents
End If
Next
End Sub

お礼

ご回答ありがとうございます！
とてもスマートな式で驚きました。
しかし自動配列機能が消えてしまったのでやはりこの機能だけは残しておきたいです。
式が表示されないで自動配列は不可能なのでしょうか。

回答No.2

tom04

こんばんは！
横からお邪魔します。
修正ではないのですが・・・
一例です。

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns(3)) Is Nothing Or Selection.Count <> 1 Then Exit Sub
Dim i As Long
i = Target.Row
If i > 3 Then
If Target = "" Then
Range(Cells(i, 1), Cells(i, 2)).ClearContents
Else
Cells(i, 1) = WorksheetFunction.Count(Range(Cells(4, 1), Cells(i, 1))) + 1
With Cells(i, 2)
.NumberFormatLocal = "yyyy/m/d"
.Value = Date
End With
End If
End If
End Sub

こんな感じではどうでしょうか？m(_ _)m

お礼

ご回答ありがとうございます！
A列の式は消えて、NO1から表示されるようになりました！
しかしその代わりに消えてしまった機能として、自動配列機能が消えてしまいました。
例えばC4→C6→C5と入力した場合に、番号が上から１，２，２，となってしまいます。
そんなことは式を入れないと無理だということでありましたら、この自動配列機能のほうが自分に
とっては重要なので、A列に式が表示されてもいいので修正していただけると幸いですm(_ _)m

補足

また、日付の表示形式が固定されてしまったのでこれも固定されずに前もって表示させたい
形式が維持できたらなお良いです。

回答No.1

bin-chan

> 現状の問題として、
> (1)A列に計算式が入ってしまうこと
> (2)C３セルに品名という項目が入っているために、C４から品目を入力していく上で、最初の割り振られるNOが２番からになってしまう

どうなれば良いのですか？

(1)A列に何を入れる？（あるいは入れない？）
cells(h.row, "A").formular1c1 = "=COUNTA(R1C[2]:RC[2])"
を編集する

(2)最初の割り振られるNOが２番からになってしまう
cells(h.row, "A").formular1c1 = "=COUNTA(R1C[2]:RC[2])-1"
でどうなりますか？

お礼

ヒントをありがとうございます。検討致します・・

補足

A列に式を表示しなければ、自動配列をしない問題が現在発生しています。
表示させずに自動配列できる方法を模索しています。