Excel Forum

Code: Select all

Option Explicit

Sub RecordData()
Dim rInput As Range
Dim rData As Range
Dim rCheck As Range
Application.ScreenUpdating = False
With Worksheets("Input")
    Set rInput = .Range("C5, E5, G5, I5, K5")
    Set rCheck = .Range("M5")
End With
With Worksheets("Data")
        Set rData = .Range("A65536").End(xlUp).Offset(1, 0)
End With
If Application.CountA(rInput) < 5 Then
    MsgBox "ข้อมูลไม่ครบ"
    Exit Sub
End If
rInput.Copy
rData.PasteSpecial xlPasteValues
Application.CutCopyMode = False
MsgBox "Record Complete"
Worksheets("Input").Range("C5").Select
Application.ScreenUpdating = True
End Sub

Sub DeleteData()
Dim rData As Range
Dim rCheck As Range
Application.ScreenUpdating = False
With Worksheets("Input")
    Set rCheck = .Range("M5")
End With
Application.ScreenUpdating = False
With Worksheets("Data")
    If Application.IsNA(rCheck) Then
        MsgBox "ไม่มีข้อมูลที่ต้องการลบ"
        Exit Sub
    Else
     Set rData = .Range("A1").Offset(rCheck, 0)
    End If
End With
rData.EntireRow.Delete
Application.CutCopyMode = False
MsgBox "ลบข้อมูลเรียบร้อยแล้ว"
Call ReplaceFormula
Worksheets("Input").Range("C5").Select
Application.ScreenUpdating = True
End Sub

Sub ReplaceFormula()
Dim r As Range
Set r = Worksheets("Input").Range("C5, E5, G5, I5, K5, M5")
r.Replace What:="999", Replacement:="1000"
End Sub

Sub Recalculate()
Application.Calculate
If Worksheets("Input").Range("C6") = "ไม่พบข้อมูล" Then
    MsgBox "ไม่พบข้อมูล"
Else
    MsgBox "ตรวจสอบเรียบร้อยแล้ว"
End If
End Sub

Sub ReplaceData()
Dim rInput As Range
Dim rData As Range
Dim rCheck As Range
Application.ScreenUpdating = False
With Worksheets("Input")
    Set rInput = .Range("C5, E5, G5, I5, K5")
    Set rCheck = .Range("M5")
End With
With Worksheets("Data")
    If Application.IsNA(rCheck) Then
        MsgBox "ไม่มีรายการให้แก้ไข ตรวจสอบข้อมูลใหม่อีกครั้ง"
        Exit Sub
    Else
        Set rData = .Range("A1").Offset(rCheck, 0)
    End If
End With
If Application.CountA(rInput) < 5 Then
    MsgBox "ข้อมูลไม่ครบ"
    Exit Sub
End If
rInput.Copy
rData.PasteSpecial xlPasteValues
Application.CutCopyMode = False
MsgBox "แก้ไขข้อมูลเรียบร้อยแล้ว"
Worksheets("Input").Range("C5").Select
Application.ScreenUpdating = True
End Sub