ต้องการเขียนโค๊ตเพื่อนำข้อมูลกลับไปใส่ในตารางข้อมูลเดิม

[sakajohn]

อยากทราบว่าถ้าต้องการเรียกข้อมูลเดิมมาทำการแก้ไข แล้วSaveกลับไปยังตำแหน่งเดิม จะต้องเขียนโค๊ตอย่างไร

คือผมมีชีท แก้ไขราคา โดยใช้เลขที่เอกสารเป็นตัวดึงข้อมูลขึ้นมา แล้วต้องการเพิ่มตัวเลขราคาลงไปในช่องราคา

จากนั้นกดปุ่มบันทึก แล้วให้ข้อมูลราคากลับไปบันทึกในชีท DATA โดยจะไปอยู่ในเซลที่ว่างไว้ ครับ

[snasui]

Code ที่เขียนมาเองแล้วชื่อว่า Procedure อะไร ติดขัดที่บรรทัดใดครับ

[sakajohn]

Code ที่เขียนมาเองแล้วชื่อว่า Procedure อะไร ติดขัดที่บรรทัดใดครับ

ตอนนี้ผมใช้วิธีคือทำการสร้างsheet DATA1 ขึ้นมาเพื่อรับค่าจาก จากsheet EditQuatation พอกดบันทึก มันก็ยังสามารถบันทึกค่าเดิมซ๊ำๆได้

ผมลองใสค่าเป็น set rg= range(I4) เพื่อให้ดูตรงรหัสห้ามซ้ำ ปรากฏว่าข้อมูลผิดตำแหน่งครับ

sheet 12 EditQuatation

Private Sub cmdEdite_Click()

Dim rg As Range

Set rg = Range("B4")

rg.Activate
If rg.Value = "" Then Exit Sub
If IsDuplicate(rg.Value) Then
MsgBox "ข้อมูลซ้ำเรียกหัวหน้าแก้ไข", vbCritical
Exit Sub
End If

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Private Sub cmdEdite_Click()

Dim rg As Range
Dim l As Long
Set rg = Range("B4")

rg.Activate
If rg.Value = "" Then Exit Sub
If IsDuplicate(rg.Value) Then
    MsgBox "ข้อมูลซ้ำเรียกหัวหน้าแก้ไข", vbCritical
    Exit Sub
End If
With Sheets("DATA1")
    If Application.CountIf(.Range("a:a"), Sheets("EditQuataion").Range("i4")) > 0 Then
        l = Application.Match(Sheets("EditQuataion").Range("i4"), .Range("a:a"), 0)
    Else
        l = Sheets("DATA1").Range("a" & Rows.Count).End(xlUp).Row + 1
    End If
End With
With Worksheets("DATA1")
    With .Range("a" & l)
    'Other code...
End Sub

[sakajohn]

ขอบคุณครับ

[sakajohn]

ผมลองนำโค๊ดที่ได้ไปใส่แล้ว แต่มันยังสามารถคิย์ข้อมูลซ๊ำได้อยู่ครับ

Private Sub cmdEdite_Click()

Dim rg As Range
Dim l As Long
Set rg = Range("B4")

rg.Activate
If rg.Value = "" Then Exit Sub
If IsDuplicate(rg.Value) Then
MsgBox "ข้อมูลซ๊ำเรียกหัวหน้าแก้ไข", vbCritical
Exit Sub
End If
With Sheets("DATA1")
If Application.CountIf(.Range("a:a"), Sheets("EditQuataion").Range("i4")) > 0 Then
l = Application.Match(Sheets("EditQuataion").Range("i4"), .Range("a:a"), 0)
Else
l = Sheets("DATA1").Range("a" & Rows.Count).End(xlUp).Row + 1
End If
End With
With Worksheets("DATA1")
With .Range("a" & Rows.Count).End(xlUp).Offset(1, 0)
.Offset(0, 0).Value = rg.Offset(0, 6).Value 'เลขที่เอกสาร
.Offset(0, 1).Value = rg.Offset(0, 12).Value 'วันที่
.Offset(0, 2).Value = rg.Offset(0, 1).Value 'ชื่อบริษัท
.Offset(0, 3).Value = rg.Offset(2, 1).Value 'ชื่อผู้ติดต่อ
.Offset(0, 4).Value = rg.Offset(4, 1).Value 'เบอร์โทรลูกค้า
.Offset(0, 5).Value = rg.Offset(2, 6).Value 'ชื่อฝ่ายขาย
.Offset(0, 6).Value = rg.Offset(4, 6).Value 'เบอร์โทรฝ่ายขาย
End With
End With
End Sub

Private Function IsDuplicate(c) As Boolean
Dim rg As Range
Set rg = Worksheets("DaTa1").Range("A:A")
If rg.Find(c, LookIn:=xlValues, Lookat:=xlWhole) Is Nothing Then
IsDuplicate = False
Else
IsDuplicate = True
End If
End Function

[niwat2811]

ลองเปลี่ยน Set rg = Range("B4")
เป็น Set rg = Range("I4")

[sakajohn]

ลองเปลี่ยน Set rg = Range("B4")
เป็น Set rg = Range("I4")

พอเปลี่ยนเป็น I4 กล่องข้อความโชว์ครับ แต่พอบันทึกค่า ข้อมูลจะไม่ลงตามตารางครับ จะเลื่อนไปครับ

[snasui]

เปลี่ยน Code นี้ให้เหมือนกับที่ผมโพสต์ตอบไปครับ

Code: Select all

With .Range("a" & Rows.Count).End(xlUp).Offset(1, 0)

สังเกตว่าผมเปลียนไปอย่างไร ลองเปลี่ยนให้เป็นตามนั้นครับ