Snasui Excel Forum

Code: Select all

Private Sub cmdSave_Click()
Dim rg As Range

Set rg = Range("C3")

rg.Activate
If rg.Value = "" Then
MsgBox "ใส่ข้อมูลให้ครบ", vbCritical
    Exit Sub
End If
If isDuplicate(rg.Value) Then
    MsgBox "ข้อมูลซ๊ำ", vbCritical
    Exit Sub
End If

With Workbooks("Dataapp.xlsx").Worksheets("Data")
    With .Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        .Offset(0, 0).Value = rg.Offset(0, 0).Value 'จินเม่าโค๊ด
        .Offset(0, 1).Value = rg.Offset(0, 4).Value
        .Offset(0, 2).Value = rg.Offset(0, 8).Value
        .Offset(0, 3).Value = rg.Offset(2, 0).Value
        .Offset(0, 4).Value = rg.Offset(2, 4).Value
        .Offset(0, 5).Value = rg.Offset(2, 8).Value
        .Offset(0, 6).Value = rg.Offset(2, 10).Value
        .Offset(0, 7).Value = rg.Offset(4, 0).Value
        .Offset(0, 8).Value = rg.Offset(4, 4).Value
        .Offset(0, 9).Value = rg.Offset(6, 0).Value
        .Offset(0, 10).Value = rg.Offset(6, 4).Value
        .Offset(0, 11).Value = rg.Offset(8, 0).Value
        .Offset(0, 12).Value = rg.Offset(8, 4).Value
        .Offset(0, 13).Value = rg.Offset(10, 0).Value
        .Offset(0, 14).Value = rg.Offset(10, 4).Value
        .Offset(0, 15).Value = rg.Offset(12, 0).Value
        .Offset(0, 16).Value = rg.Offset(12, 4).Value
        .Offset(0, 17).Value = rg.Offset(4, 8).Value
        .Offset(0, 18).Value = rg.Offset(6, 8).Value
        .Offset(0, 19).Value = rg.Offset(22, 4).Value
        .Offset(0, 20).Value = rg.Offset(14, 0).Value
        .Offset(0, 21).Value = rg.Offset(14, 4).Value
        .Offset(0, 22).Value = rg.Offset(8, 8).Value
        .Offset(0, 23).Value = rg.Offset(16, 0).Value
        .Offset(0, 24).Value = rg.Offset(18, 0).Value
        .Offset(0, 25).Value = rg.Offset(20, 0).Value
        .Offset(0, 26).Value = rg.Offset(22, 0).Value
        .Offset(0, 27).Value = rg.Offset(24, 0).Value
        .Offset(0, 28).Value = rg.Offset(16, 4).Value
        .Offset(0, 29).Value = rg.Offset(10, 8).Value
        .Offset(0, 30).Value = rg.Offset(12, 8).Value
        .Offset(0, 31).Value = rg.Offset(24, 4).Value
        .Offset(0, 32).Value = rg.Offset(18, 4).Value
        .Offset(0, 33).Value = rg.Offset(20, 4).Value
        .Offset(0, 34).Value = rg.Offset(14, 8).Value
        .Offset(0, 35).Value = rg.Offset(26, 0).Value
        .Offset(0, 36).Value = rg.Offset(16, 8).Value ' remark2
        .Offset(0, 37).Value = rg.Offset(18, 8).Value ' รายละเอียดเพิ่มเติม
        .Offset(0, 38).Value = rg.Offset(20, 8).Value
        .Offset(0, 39).Value = rg.Offset(22, 8).Value
        .Offset(0, 40).Value = rg.Offset(24, 8).Value
        .Offset(0, 41).Value = rg.Offset(17, 0).Value ' ส่วนผสมสี
        .Offset(0, 42).Value = rg.Offset(19, 0).Value ' ส่วนผสมสี
        .Offset(0, 43).Value = rg.Offset(21, 0).Value
        .Offset(0, 44).Value = rg.Offset(23, 0).Value
        .Offset(0, 45).Value = rg.Offset(25, 0).Value
        .Offset(0, 46).Value = rg.Offset(27, 0).Value
        .Offset(0, 47).Value = rg.Offset(26, 8).Value
        
    End With
End With
Range("c3,c5,c7,c9,c11,c13,c15,c17,c19,c20,c21,c22,c23,c24,c25,c26,c27,c28,c29,c30,g3,g5,g7,g9,g11,g13,g15,g17,g19,g21,g23,g25,g27,k3,k5,k7,k9,k11,k13,k15,k17,K19,k21,k23,k25,k27,K29,m5").Select
        Application.CutCopyMode = False
        MsgBox "จัดเก็บข้อมูลเรียบร้อยแล้ว"
        Selection.ClearContents
        Range("c3").Select
        Workbooks("Dataapp.xlsx").Activate
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Workbooks.Open "D:\app\Dataapp.xlsx"
    ThisWorkbook.Activate
End Sub

Code: Select all

Private Sub cmdSave1_Click()
    Dim InputRange As Range, Target As Range
    Application.EnableEvents = False
    Set InputRange = Range("c3,G3,K3,c5,g5,k5,m5,c7,g7,c9,g9,c11,g11,c13,g13,c15,g15,k7,k9,g25,c17,g17,k11,c19,c21,c23,c25,c27,g19,k13,k15,g27,g21,g23,k17,c29,k19,k21,k23,k25,k27,c20,c22,c24,c26,c28,c30,k29")
     Set Target = Workbooks("Dataapp.xlsx").Worksheets([A32].Value).Range("A" & Rows.Count).End(xlUp)
    For Each cll In InputRange
        Target.Offset(1, C).Value = cll.Value
        C = C + 1
    Next
    Application.EnableEvents = True
     Workbooks("Dataapp.xlsx").Worksheets("Data").Range("A2:AV15000").Value = _
        Workbooks("Dataapp.xlsx").Worksheets("Data").Range("A2:AV15000").Value
    
    Workbooks("Dataapp.xlsx").Close True
       Workbooks.Open "D:\app\Dataapp.xlsx"
       ThisWorkbook.Activate
    Range("c3,c5,c7,c9,c11,c13,c15,c17,c19,c20,c21,c22,c23,c24,c25,c26,c27,c28,c29,c30,g3,g5,g7,g9,g11,g13,g15,g17,g19,g21,g23,g25,g27,k3,k5,k7,k9,k11,k13,k15,k17,K19,k21,k23,k25,k27,K29,m5").Select
    MsgBox "จัดเก็บข้อมูลเรียบร้อยแล้ว"
    Selection.ClearContents
    Range("C3").Select
    ThisWorkbook.Save
End Sub

Code: Select all

Private Function isDuplicate(C) As Boolean
    Dim rg As Range
    Set rg = Workbooks("Dataapp.xlsx").Worksheets("Data").Range("A:A")
    If Application.CountIf(rg, C) = 0 Then 'rg.Find(C, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
        isDuplicate = False
    Else
        isDuplicate = True
    End If
End Function

Code: Select all

Application.Calculation = xlCalculationManual
'...Your code
Application.Calculation = xlCalculationAutoMatic

Code: Select all

Application.Calculation = xlCalculationManual
'...Your code
end