:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup: สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ :arrow: ระบุ Version ของ Excel
:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser
🪷 คำแสดงเจตนา
ขอผลแห่งการให้ความรู้นี้ จงกลับไปยังผู้ที่เป็นเจ้าของเดิม แม้ข้าพเจ้าจะไม่รู้จักท่านก็ตาม ขอให้แสงแห่งปัญญาที่ท่านเคยจุดไว้ ได้กลับไปเติมเต็มชีวิตของท่านอีกครั้ง และขอให้เจตนาของข้าพเจ้าเป็นการคืนความดีอย่างสงบ

ปรับโค๊ดยังให้ให้คำนวณไวขึ้น

ฟอรัมถาม-ตอบปัญหาการใช้งาน MS Excel and VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
Post Reply
semikolon
Member
Member
Posts: 12
Joined: Mon Apr 20, 2015 4:02 pm

ปรับโค๊ดยังให้ให้คำนวณไวขึ้น

#1

Post by semikolon »

Code: Select all

Sub AddOrderStock()
Dim A
Dim B
Set A = Range("Table110[ÃËÑÊÊÔ¹¤éÒ]")
Set B = Range("A13")
On Error Resume Next
If V = Application.WorksheetFunction.VLookup(B, A, 1, False) Then
    If Range("A13") = "/x" Then
    MsgBox "¤Ø³·ÓÃÒ¡ÒÃäÁè¶Ù¡µéͧ"
    End
    End If
    If MsgBox("ÃËÑÊÊÔ¹¤éÒÊÒÁÒöãªéä´é", vbOKCancel + vbQuestion, "ÃËÑÊÊÔ¹¤éÒ") = vbOK Then
    Range("B13:F13").Select
    Selection.Copy
    Range("B65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H13").Select
    Selection.Copy
    Range("Table110[ÃËÑÊÊÔ¹¤éÒ]").End(xlDown).Offset(0, 7).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'refresh
    Range("B13:F13,H13").Select
    Selection.ClearContents
    
'Add New Sheet
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveCell.FormulaR1C1 = "ÃËÑÊÊÔ¹¤éÒ"
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "Çѹ·Õè"
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "ÃÒ¡ÒÃ"
    Range("C4").Select
    ActiveCell.FormulaR1C1 = "àÅ¢·ÕèãºÊÑ觫×éÍ"
    Range("D4").Select
    ActiveCell.FormulaR1C1 = "àÅ¢·ÕèãºàʹÍÃÒ¤Ò"
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "àÅ¢·Õè¼ÅÔµ"
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "¨Ó¹Ç¹ÃѺ"
    Range("G4").Select
    ActiveCell.FormulaR1C1 = "¨Ó¹Ç¹¨èÒÂ"
    Range("H4").Select
    ActiveCell.FormulaR1C1 = "¤§àËÅ×Í"
    Range("I4").Select
    ActiveCell.FormulaR1C1 = "¨Ó¹Ç¹àÈÉ"
    Range("J4").Select
    ActiveCell.FormulaR1C1 = "ÃÒ¤Ò"
    Range("A4:J5").Select
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$4:$J$5"), , xlYes).Name = _
        "Table.Count"
    Application.WindowState = xlMaximized
    ActiveSheet.ListObjects("Table.Count").TableStyle = "TableStyleMedium8"
    Application.Left = 1
    Application.Top = 1
    Application.Width = 512.25
    Application.Height = 553.5
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "µÑ駵é¹"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "ÃѺ·Ñé§ËÁ´"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "¨èÒ·Ñé§ËÁ´"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "¤§àËÅ×Í"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "àËÅ×ÍàÈÉ"
    Range("E1:I2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("E1:I1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Range("F2").Select
    Selection = "=SUM(F5:F999999)"
    Range("G2").Select
    Selection = "=SUM(G5:G999999)"
    Range("H2").Select
    Selection = "=E2+F2-G2"
    Range("I2").Select
    Selection = "=SUM(I5:I999999)"
         'ÅÔé§Ë¹éÒáá
    Range("J2").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "á¼è¹!A1", TextToDisplay:="¡ÅѺ˹éÒáá"
    'ÅÔé§ÃËÑÊÊÔ¹¤éÒÊØ´·éÒÂ
    Worksheets("á¼è¹").Select
    Dim m
   m = Sheets.Count - 1
   If MsgBox("¤Ø³µéͧ¡ÒÃàª×èÍÁ⧡Ѻ Sheet" & m & " ãªèËÃ×ÍäÁè ?", vbOKCancel, "Hyperlink") = vbOK Then
   Range("Table110[ÃËÑÊÊÔ¹¤éÒ]").End(xlDown).Select
   ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "Sheet" & m & "!A1"
    Range("Table110[ÃËÑÊÊÔ¹¤éÒ]").End(xlDown).Offset(0, 9).Select
    Selection = "=Sheet" & m & "!E2"
   Range("Table110[ÃËÑÊÊÔ¹¤éÒ]").End(xlDown).Offset(0, 10).Select
     Selection = "=Sheet" & m & "!F2"
    Range("Table110[ÃËÑÊÊÔ¹¤éÒ]").End(xlDown).Offset(0, 11).Select
     Selection = "=Sheet" & m & "!G2"
    Range("Table110[ÃËÑÊÊÔ¹¤éÒ]").End(xlDown).Offset(0, 12).Select
    Selection = "=Sheet" & m & "!H2"
    Range("Table110[ÃËÑÊÊÔ¹¤éÒ]").End(xlDown).Offset(0, 13).Select
    Selection = "=Sheet" & m & "!I2"
    Range("Table110[ÃËÑÊÊÔ¹¤éÒ]").End(xlDown).Select
    Selection.Copy
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    
    
    'save
        ActiveWorkbook.Save
        MsgBox "ºÑ¹·Ö¡ÊÓàÃç¨"
    End If
Else
If MsgBox("ÃËÑÊÊÔ¹¤éÒ " & B & " ÁÕÍÂÙèáÅéÇ" & vbCrLf & "µéͧ¡ÒÃä»Âѧ˹éҺѹ·Ö¡¢éÍÁÙÅËÃ×ÍäÁè ?", vbOKCancel + vbQuestion, "µÃÃǨÊͺÃËÑÊÊÔ¹¤éÒ") = vbOK Then
   Dim r
For r = 16 To 65536
On Error Resume Next
If Cells(r, 1) = Range("A13") Then
'MsgBox ("á¶Ç·Õè" & r)
Cells(r, 1).Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Exit For
Cells(r, 1).Select
End If
Next r
End If
End If
End Sub
จากโค๊ดด้านบนที่ผมลองเขียน และนำไปใช้งาน ช่วงแรกก็ใช้งานได้ปกติ แต่พอใช้ไปๆ ก็มีข้อความขึ้นว่า "ทรัพยากรระบบไม่มีทรัพยากรระบบไม่เพียงพอที่จะแสดงผลได้อย่างสมบูรณ์" ผมคาดว่าน่าจะเป็นเพราะ RAM ไม่พอ แต่อยากให้ช่วยแนะนำว่าจะสามารถปรับโค๊ดให้มีการคำนวณได้เร็วกว่านี้มั้ยครับ รบกวนผู้รู้แนะนำทีครับ ผมแนบไฟล์ไว้ด้วย
You do not have the required permissions to view the files attached to this post.
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31176
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: ปรับโค๊ดยังให้ให้คำนวณไว้ขึ้น

#2

Post by snasui »

:D ช่วยอธิบายว่าช้าในขั้นตอนไหน อย่างไร บอกค่าที่จำเป็นต้องใช้และวิธีการทดสอบมาด้วยครับ

การเพิ่มชีตไปเรื่อย ๆ ย่อมกินทรัพยากร ไม่ทราบว่ามีเหตุผลใดที่ต้องเพิ่มชีตไปเรื่อย ๆ แทนการวางในชีตใดชีตหนึ่งครับ
Top
semikolon
Member
Member
Posts: 12
Joined: Mon Apr 20, 2015 4:02 pm

Re: ปรับโค๊ดยังให้ให้คำนวณไวขึ้น

#3

Post by semikolon »

>>ในชีทแรก จะทำการป้อนค่าลงในช่อง B13, C13, D13, E13, F13 และ H13 ครับ จากนั้นทำการคลิกปุ่ม "กดเพิ่มรายการ" ตัวโค๊ดจะทำการรันนำข้อมมูลที่กรอกไปเพิ่มลงที่บรรทัดสุดท้ายของตารางด้านล่างในหน้าแรก และจะสร้างชีทขึ้นมาใหม่ 1 ชีท โดยในหน้าชีทใหม่จะสร้างแบบฟอร์มที่เขียนไว้และบันทึกข้อมูลที่ได้ป้อนไว้ จากนั้นจะทำการลิ้งค์เชื่อมโยงระหว่างชีทหน้าแรกกับชีทที่เพิ่มใหม่ครับ
>>เหตุผลที่ต้องเพิ่มชีทใหม่ เพื่อใช้ลงรายละเอียดในการเบิก-จ่ายผลิตภัณฑ์ชนิดนั้นๆครับ
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31176
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: ปรับโค๊ดยังให้ให้คำนวณไวขึ้น

#4

Post by snasui »

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

Code: Select all

Sub AddOrderStock()
    Dim A As Range, B As Range
    Set A = Range("Table110[รหัสสินค้า]")
    Set B = Range("A13")
    'On Error Resume Next
    If Application.WorksheetFunction.CountIf(A, B) = 0 Then
        If Range("A13") = "/x" Then
            MsgBox "คุณทำรายการไม่ถูกต้อง"
            End
        End If
        If MsgBox("รหัสสินค้าสามารถใช้ได้", vbOKCancel + vbQuestion, "รหัสสินค้า") = vbOK Then
        
            Range("B65536").End(xlUp).Offset(1, 0).Value = Range("B13:F13").Value
            Range("Table110[รหัสสินค้า]").End(xlDown).Offset(0, 7).Value = Range("H13").Value
            'refresh
            Range("B13:F13,H13").ClearContents
            
            'Add New Sheet
            Sheets.Add After:=Sheets(Sheets.Count)
            Range("A4:I4").Value = Array("รหัสสินค้า", "วันที่", "รายการ", "เลขที่ใบสั่งซื้อ", "เลขที่ใบเสนอราคา", _
                "เลขที่ผลิต", "จำนวนรับ", "จำนวนจ่าย", "คงเหลือ", "จำนวนเศษ", "ราคา")
            ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$4:$J$5"), , xlYes).Name = _
                "Table.Count"
            With Application
                .WindowState = xlMaximized
                .ActiveSheet.ListObjects("Table.Count").TableStyle = "TableStyleMedium8"
            End With
            
            Range("E1:I1").Value = Array("ตั้งต้น", "รับทั้งหมด", "จ่ายทั้งหมด", "คงเหลือ", "เหลือเศษ")
            
            With Range("E1:I2")
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlInsideVertical).LineStyle = xlContinuous
                .Borders(xlInsideHorizontal).LineStyle = xlContinuous
            End With
            With Range("E1:I1")
                With .Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
                With .Font
                    .ThemeColor = xlThemeColorDark1
                    .TintAndShade = 0
                End With
            End With
            Range("F2").Formula = "=SUM(F5:F999999)"
            Range("G2").Formula = "=SUM(G5:G999999)"
            Range("H2").Formula = "=E2+F2-G2"
            Range("I2").Formula = "=SUM(I5:I999999)"
                 'ลิ้งหน้าแรก
            Range("J2").Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
                "แผ่น!A1", TextToDisplay:="กลับหน้าแรก"
            'ลิ้งรหัสสินค้าสุดท้าย
            Worksheets("แผ่น").Select
            Dim m As Long
            m = Sheets.Count - 1
           
           If MsgBox("คุณต้องการเชื่อมโยงกับ Sheet" & m & " ใช่หรือไม่ ?", vbOKCancel, "Hyperlink") = vbOK Then
                Range("Table110[รหัสสินค้า]").End(xlDown).Select
                ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
                     "Sheet" & m & "!A1"
                 Range("Table110[รหัสสินค้า]").End(xlDown).Offset(0, 9).Formula = "=Sheet" & m & "!E2"
                 Range("Table110[รหัสสินค้า]").End(xlDown).Offset(0, 10).Formula = "=Sheet" & m & "!F2"
                 Range("Table110[รหัสสินค้า]").End(xlDown).Offset(0, 11).Formula = "=Sheet" & m & "!G2"
                 Range("Table110[รหัสสินค้า]").End(xlDown).Offset(0, 12).Formula = "=Sheet" & m & "!H2"
                 Range("Table110[รหัสสินค้า]").End(xlDown).Offset(0, 13).Formula = "=Sheet" & m & "!I2"
                 Range("Table110[รหัสสินค้า]").End(xlDown).Select
                 Selection.Copy
                 Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
                 Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                     :=False, Transpose:=False
                Application.CutCopyMode = False
            End If
            
            'save
            ActiveWorkbook.Save
            MsgBox "บันทึกสำเร็จ"
        End If
    Else
        If MsgBox("รหัสสินค้า " & B & " มีอยู่แล้ว" & vbCrLf & "ต้องการไปยังหน้าบันทึกข้อมูลหรือไม่ ?", _
            vbOKCancel + vbQuestion, "ตรรวจสอบรหัสสินค้า") = vbOK Then
            Dim r As Long
            For r = 16 To 65536
                On Error Resume Next
                If Cells(r, 1) = Range("A13") Then
                    'MsgBox ("แถวที่" & r)
                    Cells(r, 1).Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
                    Exit For
                    'Cells(r, 1).Select
                End If
            Next r
        End If
    End If
End Sub
Top
Post Reply

Return to “Excel”