เพิ่มข้อมูลใหม่

[san02551]

สวัสดีปีใหม่ ครับ
จากไฟล์ที่แนบ ผมต้องการค้นหาข้อมูล จากกลุ่มคำครับ เช่น กระดาษ ก็แสดงข้อมูลที่มีคำว่า กระดาษ แสดง ครับ
โดยใส่คำค้นหาที่ N5 ข้อมูลจะแสดงที่ N7:P50 หรือจากจำนวนข้อมูลที่มี ครับ

[logic]

ลองทดสอบสูตรนี้ที่ N7 ครับ

=IFERROR(INDEX(Sheet2!A$3:A$19,SMALL(IF(ISNUMBER(SEARCH($N$5,Sheet2!$A$3:$A$19)),ROW(Sheet2!$A$3:$A$19)-ROW(Sheet2!$A$3)+1),ROWS(N$7:N7))),"")

เป็นสูตรอาร์เรย์ต้องกดแป้น Ctrl+Shift+Enter แล้วค่อย Copy ไปวางด้านขวาและด้านล่าง

[san02551]

ข้อมูลมีประมาณ 2000 แถว ครับ ดึงข้อมูลรอนานมากครับ พอจะมีวิธีการอื่นไหม ครับ

[snasui]

การใช้สูตรกับข้อมูลปริมาณมากๆ จะเกิดการคำนวณนาน ยิ่งข้อมูลมากก็จะยิ่งช้า หากต้องการให้เร็วคงต้องหันมาใช้ VBA ลองเขียนมาเองก่อน ติดตรงไหนค่อยถามกันต่อครับ

[san02551]

ที่ Sheet1 cell b1 พิมพ์คำว่า กระดาษ คลิกปุ่มค้นหา
ให้โชว์ข้อมูล หมวดกระดาษที่ b3:d50
(หรือเท่าจำนวนที่มี ครับ)

[snasui]

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

Code: Select all

Sub Rectangle1_Click()
    Dim r As Range, rall As Range
    Dim rcheck As Range
    Set rcheck = Sheets(1).Range("b1")
    Sheets(1).Range("b3").Resize(1000, 3).ClearContents
    With Sheets(2)
        Set rall = .Range("a3", .Range("a" & .Rows.Count).End(xlUp))
        For Each r In rall
            If InStr(r.Value, rcheck) > 0 Then
                With Sheets(1)
                    .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 3).Value _
                        = r.Resize(1, 3).Value
                End With
            End If
        Next r
    End With
End Sub

[san02551]

Code: Select all

Sub Rectangle1_Click()
    Dim r As Range, rall As Range
    Dim rcheck As Range
    Set rcheck = Sheets(Edit).Range("b1")
    Sheets(Edit).Range("b3").Resize(1000, 3).ClearContents
    With Sheets(raca)
        Set rall = .Range("a3", .Range("a" & .Rows.Count).End(xlUp))
        For Each r In rall
            If InStr(r.Value, rcheck) > 0 Then
                With Sheets(Edit)
                    .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 3).Value _
                        = r.Resize(1, 3).Value
                End With
            End If
        Next r
    End With
End Sub

[san02551]

พอดีผมได้เพิ่ม Sheet ขึ้นมาอีก เพื่อนำไปใช้งานจริง และก็ได้เปลี่ยนชื่อ Sheet ใหม่ ที่code ผมได้แก้ไข แต่ผมไม่เข้าใจครับ

[snasui]

เท่าที่เห็นชื่อชีทยังไม่ถูกต้อง จะต้องครอบด้วยฟันหนู ไม่เช่นนั้นก็ต้องใส่ลำดับของชีทนั้น ๆ ตามตัวอย่างที่ให้ไปครับ

[san02551]

ขอคุณครับ ลองทำดูก่อน ติดตรงไหน ผมขอรบกวนอีกครั้ง เป็นโปรแกรมจัดซื้อจัดจ้างของโรงเรียนครับ

[snasui]

เท่าที่เห็นชื่อชีทยังไม่ถูกต้อง จะต้องครอบด้วยฟันหนู ไม่เช่นนั้นก็ต้องใส่ลำดับของชีทนั้น ๆ ตามตัวอย่างที่ให้ไปครับ

ผมหมายถึงชื่อชีทที่เขียนไว้ใน Code นะครับ

[san02551]

ไฟล์ที่ทำการแก้ไขแล้ว ครับ

Code: Select all

Sub Rectangle1_Click()
    Dim r As Range, rall As Range
    Dim rcheck As Range
    Set rcheck = Sheets("edit").Range("b1")
    Sheets("edit").Range("b3").Resize(1000, 4).ClearContents
    With Sheets("raca")
        Set rall = .Range("a3", .Range("a" & .Rows.Count).End(xlUp))
        For Each r In rall
            If InStr(r.Value, rcheck) > 0 Then
                With Sheets("edit")
                    .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 4).Value _
                        = r.Resize(1, 4).Value
                End With
            End If
        Next r
    End With
End Sub

[san02551]

เรียน ทุกๆท่าน ที่เคารพ
ผมต้องการพิมพ์ข้อมูลที่ Sheet print โดยสร้างปุ่มสั่งพิมพ์ไว้ที่ Sheet menu เวลาสั่งพิมพ์ ผมไม่ต้องการให้ โชว์ Sheet print และ พอจะเขียน Code สั่งให้พิมพ์ เฉพาะที่มีข้อมูลใน cell ได้ไหม ครับ
ผมเขียน Code ให้พิมพ์ตั้งแต่ b2:f338 ครับ (เพราะต้องเพิ่มข้อมูลอีก ครับ)

Code: Select all

Sub Rectangle1_Click()
Application.ScreenUpdating = False
Sheets("print").Visible = True
Sheets("print").Select
ActiveSheet.PageSetup.PrintArea = "$b$2:$f$338"
ActiveWindow.SelectedSheets.PrintOut copies:=1, collate:=True
Sheets("print").Visible = True
Application.ScreenUpdating = True
End Sub

[snasui]

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

Code: Select all

Sub Rectangle1_Click()
    Application.ScreenUpdating = False
    Sheets("print").Visible = True
    Sheets("print").Select
    ActiveSheet.PageSetup.PrintArea = ActiveSheet.Range("b2").CurrentRegion.Address
    ActiveWindow.SelectedSheets.PrintOut copies:=1, collate:=True
    Sheets("print").Visible = True
    Application.ScreenUpdating = True
End Sub

[san02551]

ส่วนก่อนนั้น ทำได้แล้วครับ
แต่ผมต้องการแทรกข้อความท้ายหน้าของแต่ละหน้า โดยถ้ามีข้อมูล ให้แทรกข้อความ
แตไม่มีข้อมูลก็ไม่ต้องแทรกข้อความ
(ส่วนหัวตารางทำได้แล้วครับ) ตัวอย่างจะอยู่ที่ Sheet data ครับ

[snasui]

คำว่า มีข้อมูลหรือไม่มีข้อมูล ตรวจสอบจากเซลล์ใดหรือตรวจสอบอย่างไรครับ

[san02551]

ตรวจสอบจาก Sheet print ตั้งแต่ b6:f2000 ( เพราะจ่าจะมีการเพิ่มข้อมูลสินค้า เรื่อยๆ ครับ)
เช่น มีข้อมูลสั่งพิมพ์ 3 หน้า ก็ให้มีการแทรกข้อความที่ หัวตาราง กับท้ายตารางโดยอัตโนมัติ ครับ
ตัวอย่าง เอกสารที่ต้องการพิมพ์ อยู่ที่ Sheet data ครับ

[snasui]

แนบ Code มาใหม่ แสดงให้เห็นว่าได้เขียน Code การตรวจสอบข้อมูลมาแล้วจะได้ตอบต่อไปจากนั้นครับ

[san02551]

Code: Select all

Sub Rectangle1_Click()
    Application.ScreenUpdating = False
    Sheets("print").Visible = True
    Sheets("print").Select
    ActiveSheet.PageSetup.PrintArea = ActiveSheet.Range("b2").CurrentRegion.Address
    ActiveWindow.SelectedSheets.PrintOut copies:=1, collate:=True
    Sheets("print").Visible = True
    Application.ScreenUpdating = True
End Sub

[snasui]

ตรวจสอบจาก Sheet print ตั้งแต่ b6:f2000 ( เพราะจ่าจะมีการเพิ่มข้อมูลสินค้า เรื่อยๆ ครับ)
เช่น มีข้อมูลสั่งพิมพ์ 3 หน้า ก็ให้มีการแทรกข้อความที่ หัวตาราง กับท้ายตารางโดยอัตโนมัติ

Code นี้ไม่ได้ต่างไปจากเดิม ไม่มีบรรทัดใดที่แสดงว่ามีการตรวจสอบข้อมูลตามทีแจ้งมา ลองพยายามมาใหม่ครับ

อ่านโพสต์นี้อีกครั้งครับ

แนบ Code มาใหม่ แสดงให้เห็นว่าได้เขียน Code การตรวจสอบข้อมูลมาแล้วจะได้ตอบต่อไปจากนั้นครับ