|
「Private Sub CommandButton2_Click()」のプロシージャを以下の様に変更して下さい
Private Sub CommandButton2_Click()
' 行の削除
Dim rngDelete As Range
Dim lngWrite As Long
'現在行が未定なら
If lngCurrent = 0 Then
Exit Sub
Else
If MsgBox(TextBox1.Text & "のデータが削除されます", _
vbExclamation + vbOKCancel, "行削除") = vbOK Then
'削除データのListの先頭セル位置を設定
Set rngDelete = Worksheets("Sheet3").Cells(1, "A")
With rngDelete
'Sheet3のデータ書き込み位置を取得
lngWrite = .Offset(65536 - .Row).End(xlUp).Row - .Row + 1
If lngWrite < 1 Then
lngWrite = 1
End If
End With
With rngList.Offset(lngCurrent)
'名簿Listの削除行を削除Listの最終行にCopy
.Resize(, lngCoiumns).Copy _
Destination:=rngDelete.Offset(lngWrite)
'H列に日付を代入(コメントアウトの行は、時刻まで入れる場合)
rngDelete.Offset(lngWrite, lngCoiumns).Value = Date
' rngDelete.Offset(lngWrite, lngCoiumns).Value = Now
'行を削除
.EntireRow.Delete
End With
Set rngDelete = Nothing
End If
'List行数をディリメント
lngRows = lngRows - 1
'IDのセル範囲を更新
Set rngSearch = rngList.Offset(1).Resize(lngRows)
End If
'TextBoxのデータをクリア
TextBox1.Text = ""
DataClear
End Sub
|
|