自動で採番と日付を入力するマクロ

質問

Sheet１のC列に何かを入力すると、A列に１から番号が振られていき、B列には入力した日付が
入っていくマクロを作りたいです。ご教授教えていただければ幸いです；

回答No.2

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("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列の任意のセルに数字を入力しても
上からちゃんと認識して数字を並び替えてくれるからです。
しかしすでにC２セルに文字が入っているため、うまくNO１からスタートしてくれません；
ちなみにC３から入力が始まります。最初にそのように前置きをおいていませんでした。大変申し訳
ありません；
そして
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column <> 1 Then Exit Sub

If Target.Count = 1 Then
i = Target.Row

Range("C1,D1").Value = Cells(i, 1).Value
End If
End Sub
という任意のA列を選択するとC1、D1に数字がコピーされるコードも入れているのですが
そのせいでうまく機能していません。
お力をいただけたら幸いです。

補足

申し訳ないです。先の問題はC1,D1の箇所を変更したら解決しました。ありがとうございます。

回答No.3

mu2011

一例です。
対象シートタブ上で右クリック→コードの表示→以下のコードを貼り付けてお試しください。

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
For Each wk In Target
If wk.Value <> "" Then
wk.Offset(0, -2).Value = Application.Max(Range("A:A")) + 1
wk.Offset(0, -1).Value = Date
Else
wk.Offset(0, -2).Resize(1, 2).ClearContents
End If
wk.Offset(0, -1).EntireColumn.AutoFit
Next
End Sub

お礼

ご回答ありがとうございます！思い通りのことができて感謝します。確かにエクセルにコードを記入して
やってみるとすんなりできました。しかし大変申し訳ないです；

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column <> 1 Then Exit Sub

If Target.Count = 1 Then
i = Target.Row

Range("C1,D1").Value = Cells(i, 1).Value
End If
End Sub

このコードを同じSheet1に入れているのですが、これはSheet１の任意のセルを選択すると
C1、D1に同じ数字を入力するコードです。この状態で教えていただいたコードでやると、
B1、C1セルに日付が勝手に入ってしまい、数字がでたらめになってしまいます；
どうすればよいでしょうか。。

補足

申し訳ないです。先の問題はC1,D1の箇所を変更したら解決しました。ありがとうございます。
問題としては、C1セル以外にもD列も入力するのですが、例えばC１セル、D１セルを同時に選択して
消去するとエラーが出ます。これはどうやっても解決できなかったので教えていただければ助かります；

回答No.1

aokii

マクロにしなくても、A列に=IF(C1="","",=ROW(A1))、B列に、=IF(C1="","",TODAY())で、下にドラッグコピーではいかがでしょう。

お礼

ご回答ありがとうございます。実はA列を選択して他にもしたいことがあります。
ですので計算式では都合が悪いのです；