เก็บข้อมูลใบเสนอราคา

[worawoot]

เก็บข้อมูล Quotation.xlsx

เรียนปรึกษาอาจารย์ ถ้าผมอยากจะเก็บข้อมูลของใบเสนอราคาเพื่อที่จะดูว่าราคาแต่ละครั้งเสนอไปเท่าไรก่อนหน้า เป็นจำนวนเท่าไร
แต่ปัญหาของผมคือผม copy ข้อมูล 1 บรรทัด ได้ หากบรรทัดของแต่ละใบเสนอราคาไม่เท่ากัน ไม่ทราบว่าต้องทำอย่างไร
หากบรรทัดไม่เท่ากันและ ต้องการใส่เลขที่ใบเสนอราคา ที่เป็นเลขที่เดียวกันด้วยนะครับหากเป็นใบเดียวกัน วันที่เดียวกัน
รบกวนอาจารย์ช่วยแนะนำว่าต้องทำอย่างไรดี ผมมีไฟล์ตัวอย่างแนบมาให้ด้วย

[snasui]

ช่วยอธิบายมาด้วยครับว่าต้องการนำข้อมูลจากไหนไปไหน ด้วยเงื่อนไขใด

หากต้องการนำข้อมูลใน Form ไปวางเป็น Database จำเป็นต้องใช้ VBA ซึ่งต้องเขียนมาก่อนตามกฎข้อ 5 ด้านบนครับ

[worawoot]

ผมต้องการนำข้อมูลจากใบเสนอราคาใน sheet Quotation ไปเก็บไว้ใน QuotationIndex ให้รายการต่อท้ายไปเรื่อยๆ นะครับ
ผมได้ลองทำโดยใช้ macro copy ข้อมลูมาตาม file แนบนะครับ แต่ผมติดตรงที่ว่า หาก มี 2 รายการผมจะทำอย่างไรให้มี
Quotation No. และวันที่ 2 บรรทัดด้วย หากเป็น 3 รายการก็จะมี Quotation No. และวันที่ 3 บรรทัด นะครับ

[snasui]

ดูตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Sub Macro3()
'
' Macro3 áÁâ¤Ã
'
' Keyboard Shortcut: Ctrl+d
'
    
    Sheets("Quotation").Select
    Range("B17").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("QuotationIndex").Select
    Range("E2000").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Selection.Offset(0, -1) = Sheets("Quotation").Range("C7").Value
    Selection.Offset(0, -2) = Sheets("Quotation").Range("I9").Value
    Selection.Offset(0, -3) = Sheets("Quotation").Range("I7").Value
    
    Selection.Offset(0, -4).Select
    For Each r In Selection
        If r.Row <> 2 Then
            r.Value = r.Offset(-1, 0) + 1
        Else
            r.Value = 1
        End If
    Next r
    
    Sheets("Quotation").Select
    Range("G17").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("QuotationIndex").Select
    Range("F2000").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
      
    Sheets("Quotation").Select
    Range("B16").Select
End Sub

[worawoot]

ขอบคุณมากครับอาจารย์ เดี๋ยวจะลองไปทำดูนะครับ ได้ผลอย่างไรจะมาแจ้งนะครับ

[worawoot]

ได้แล้วครับอาจารย์ได้ความรู้เพิ่มขึ้นด้วยขอบคุณมากครับ

[nattasiray]

แก้ไขโค้ดให้สั้นหน่อยนะครับ

Code: Select all

Sub Macro3()
'
' Macro3 áÁâ¤Ã
'
' Keyboard Shortcut: Ctrl+d
'
    
   Application.ScreenUpdating=true
   Sheets("Quotation").Select
   Range(Range("B17"),Range("B17").End(xldown)).Copy
   application.goto Sheets("QuotationIndex").Range("E2000").Range("E2000").End(xlUp).Offset(1, 0).Range("A1")
    
    Selection.Offset(0, -1) = Sheets("Quotation").Range("C7").Value
    Selection.Offset(0, -2) = Sheets("Quotation").Range("I9").Value
    Selection.Offset(0, -3) = Sheets("Quotation").Range("I7").Value
    
    Selection.Offset(0, -4).Select
    For Each r In Selection
        If r.Row <> 2 Then
            r.Value = r.Offset(-1, 0) + 1
        Else
            r.Value = 1
        End If
    Next r
    
    Sheets("Quotation").Select
    Range("G17").CurrentRegion.Copy Sheets("QuotationIndex").Range("F2000").End(xlUp).Offset(1, 0).Range("A1")
    Applcation.goto Sheets("Quotation").Range("B16")
    Application.ScreenUpdating=true
End Sub

ถ้าคุณต้องการเลือกทั้งตารางในลักษณะ สี่เหลี่ยม ให้คุณกดแป้น Ctrl+* แทนการกดแป้น Ctrl+Shift ลูกศรลง 1 ครั้งแล้วตามด้วยการกดแป้น Ctrl+Shift ลูกศรขวา 1 ครั้ง