: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

หลังจากที่ Clickปุ่ม Cal แล้ว อยากให้ผลลัพธ์ที่ต้องการ

ฟอรัมถาม-ตอบปัญหาการใช้งาน 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. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
wisitsakbenz
Silver
Silver
Posts: 505
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

หลังจากที่ Clickปุ่ม Cal แล้ว อยากให้ผลลัพธ์ที่ต้องการ

#1

Post by wisitsakbenz »

เรียน อาจารย์

ที่ Sheet "AIA" หลังจากที่ Clickปุ่ม Cal แล้ว อยากให้ผลลัพธ์แสดงออกมาดัง Sheet "สิ่งที่อยากได้ Cholec"
1.และต้องการให้ ผลรวมมีค่าเท่ากับหัวข้อใหญ่ คือ 1-8 ที่ Highlight สีแดงครับ
2.ถ้ามีการเปลี่ยนชื่อ Cholec (235,000) ใน Sheet "Display" เป็น Unilateral (239,000) Clickปุ่ม Cal ที่ Sheet "AIA" จะแสดงตาม Sheet "สิ่งที่อยากได้ Unilateral"

ต้องปรับสูตรอย่างไรครับ

Code: Select all

Private Sub CommandButton1_Click()

            Dim rFind As Range, rDataAll As Range
            Dim r As Range, rTarget As Range
            Dim ws4 As Worksheet, i As Integer
                Set ws4 = Worksheets("AIA")
                Set rFind = Sheets("Display").Range("I7")
                Application.EnableEvents = False

                ws4.Range("C12:F1000").ClearContents
                
                If Sheets("Display").Range("I7") = "" Then Exit Sub
                
            With Sheets("Data")
            
            Worksheets("AIA").Range("C21").Resize(1000, 1).EntireRow.Delete

                    Set rDataAll = .Range("B1", .Range("B" & Rows.Count).End(xlUp))
                    If .Columns("B:B").Find(rFind, LookIn:=xlValues) Is Nothing Then
                        MsgBox ("ไม่มี Package นี้")
                        Exit Sub
                    End If
                End With
                i = 12
                For Each r In rDataAll
                    If r = rFind Then
                        ws4.Range("d" & i).Resize(1, 2).Value = _
                            r.Offset(0, 1).Resize(1, 2).Value
                        i = i + 1
                    End If
                Next r
                   
        Worksheets("AIA").Range("C49:D49").Value = "Total"
        Worksheets("AIA").Range("E49:F49").Formula = "=Sum(R17C:R[-1]C)"
    Worksheets("AIA").Range("D12").Resize(600, 1).EntireRow.Insert
                
           With Sheets("AIA")
    .Range("d" & i + 2, .Range("d" & i).End(xlDown).Offset(-1, 0)) _
        .EntireRow.Delete
End With
                
                Application.EnableEvents = True
           ' MsgBox "Get data has finished."
            Set ws4 = Nothing
            Set rFind = Nothing
            Set rDataAll = Nothing
End Sub
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: หลังจากที่ Clickปุ่ม Cal แล้ว อยากให้ผลลัพธ์ที่ต้องการ

#2

Post by snasui »

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

Code: Select all

Private Sub CommandButton1_Click()

    Dim rFind As Range, rDataAll As Range
    Dim r As Range, rTarget As Range
    Dim ws4 As Worksheet, i As Integer
    Set ws4 = Worksheets("AIA")
    Set rFind = Sheets("Display").Range("I7")
    Application.EnableEvents = False
    
    ws4.Range("C12:F1000").ClearContents
    
    If Sheets("Display").Range("I7") = "" Then Exit Sub
    
    With Sheets("Data")
    
        Worksheets("AIA").Range("C21").Resize(1000, 1).EntireRow.Delete
        
        Set rDataAll = .Range("B1", .Range("B" & Rows.Count).End(xlUp))
        If .Columns("B:B").Find(rFind, LookIn:=xlValues) Is Nothing Then
            MsgBox ("äÁèÁÕ Package ¹Õé")
            Exit Sub
        End If
    End With
    i = 12
    For Each r In rDataAll
        If r = rFind Then
            ws4.Range("d" & i).Resize(1, 2).Value = _
                r.Offset(0, 1).Resize(1, 2).Value
            If IsNumeric(VBA.Left(ws4.Range("d" & i), 1)) Then
                ws4.Range("d" & i).Resize(1, 2).Font.Bold = True
                ws4.Range("e" & i).Font.Color = vbRed
            End If
            i = i + 1
        End If
    Next r
    
'    Worksheets("AIA").Range("C49:D49").Value = "Total"
'
'    Worksheets("AIA").Range("E49:F49").Formula = "=Sum(R17C:R[-1]C)"
'    Worksheets("AIA").Range("D12").Resize(600, 1).EntireRow.Insert
    
    With Sheets("AIA")
        .Range("c10:f10").Copy
        .Range("d" & .Rows.Count).End(xlUp).Offset(3, -1).Resize(1, 4).PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        With .Range("D" & .Rows.Count).End(xlUp).Offset(3, 0)
            .Offset(0, -1).Value = "Total"
            .Offset(0, 1).Formula = "=Sumifs(R11C:R[-1]C,R11C[-1]:R[-1]C[-1],""*.*"")"
            
'            .Range("D12").Resize(600, 1).EntireRow.Insert
'            .Range("d" & i + 2, .Range("d" & i).End(xlDown).Offset(-1, 0)) _
                .EntireRow.Delete
        End With
        .Range("e17", .Range("e" & .Rows.Count).End(xlUp)).NumberFormat = "#,##0"

        With .Range("e17", .Range("e" & .Rows.Count).End(xlUp)).Offset(0, -2)
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Offset(0, 1).Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Offset(0, 3).Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
        End With
    End With
    
    Application.EnableEvents = True
    ' MsgBox "Get data has finished."
    Set ws4 = Nothing
    Set rFind = Nothing
    Set rDataAll = Nothing
End Sub
wisitsakbenz
Silver
Silver
Posts: 505
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: หลังจากที่ Clickปุ่ม Cal แล้ว อยากให้ผลลัพธ์ที่ต้องการ

#3

Post by wisitsakbenz »

เรียน อาจารย์ snasui ครับ

ได้ผลตามต้องการครับ แต่อยากเพิ่มเติมคือ
1.Sheet "AIA" > Highlight สีตามหัวข้อ (ตัวอย่างตาม Sheet "สิงที่อยากได้ AIA")
2.Sheet "AIA-Detail"
- อยากให้แสดงผลรวม
- Highlight สีตามหัวข้อ
ดังตัวอย่าง Sheet "สิ่งที่อยากได้ AIADetail"

ต้องปรับ Code อย่างไรครับ ขอบคุณครับ

Code: Select all


        With Sheets("AIA-Detail")
        .Range("c10:g11").Copy
        .Range("d" & .Rows.Count).End(xlUp).Offset(3, -1).Resize(1, 4).PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        With .Range("D" & .Rows.Count).End(xlUp).Offset(3, 0)
            .Offset(0, -1).Value = "Total"
            .Offset(0, 1).Formula = "=Sumifs(R11C:R[-1]C,R11C[-1]:R[-1]C[-1],""*.*"")"
            .EntireRow.Delete
        End With
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: หลังจากที่ Clickปุ่ม Cal แล้ว อยากให้ผลลัพธ์ที่ต้องการ

#4

Post by snasui »

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

Code: Select all

Private Sub CommandButton1_Click()

    Dim rFind As Range, rDataAll As Range
    Dim r As Range, rTarget As Range
    Dim ws4 As Worksheet, i As Integer
    Set ws4 = Worksheets("AIA")
    Set ws5 = Worksheets("AIA-Detail")
    Set rFind = Sheets("Display").Range("I7")
    Application.EnableEvents = False
    
    ws4.Range("C12:F1000").ClearContents
    ws5.Range("C13:k1000").ClearContents
    
    If Sheets("Display").Range("I7") = "" Then Exit Sub
    
    With Sheets("Data")
    
        Worksheets("AIA").Range("C21").Resize(1000, 1).EntireRow.Delete
        
        Set rDataAll = .Range("B1", .Range("B" & Rows.Count).End(xlUp))
        If .Columns("B:B").Find(rFind, LookIn:=xlValues) Is Nothing Then
            MsgBox ("äÁèÁÕ Package ¹Õé")
            Exit Sub
        End If
    End With
    i = 12
    For Each r In rDataAll
        If r = rFind Then
            ws4.Range("d" & i).Resize(1, 2).Value = _
                r.Offset(0, 1).Resize(1, 2).Value
            If IsNumeric(VBA.Left(ws4.Range("d" & i), 1)) Then
                ws4.Range("d" & i).Resize(1, 2).Font.Bold = True
                ws4.Range("d" & i).Offset(0, -1).Resize(1, 4).Interior.Color = _
                    ws4.Range("c10").Interior.Color
               ' ws4.Range("e" & i).Font.Color = vbRed
            End If
            i = i + 1
        End If
    Next r
    
'    Worksheets("AIA").Range("C49:D49").Value = "Total"
'
'    Worksheets("AIA").Range("E49:F49").Formula = "=Sum(R17C:R[-1]C)"
'    Worksheets("AIA").Range("D12").Resize(600, 1).EntireRow.Insert
    
    With Sheets("AIA")
        .Range("c10:f10").Copy
        .Range("d" & .Rows.Count).End(xlUp).Offset(3, -1).Resize(1, 4).PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        With .Range("D" & .Rows.Count).End(xlUp).Offset(3, 0)
            .Offset(0, -1).Value = "Total"
            .Offset(0, 1).Formula = "=Sumifs(R11C:R[-1]C,R11C[-1]:R[-1]C[-1],""*.*"")"
            
'            .Range("D12").Resize(600, 1).EntireRow.Insert
'            .Range("d" & i + 2, .Range("d" & i).End(xlDown).Offset(-1, 0)) _
                .EntireRow.Delete
        End With
        .Range("e17", .Range("e" & .Rows.Count).End(xlUp)).NumberFormat = "#,##0"

        With .Range("e17", .Range("e" & .Rows.Count).End(xlUp)).Offset(0, -2)
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Offset(0, 1).Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Offset(0, 3).Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
        End With
    End With
    
      'Other Sheet
        
    With Sheets("Datadetail")
    
        Worksheets("AIA-Detail").Range("C21").Resize(1000, 1).EntireRow.Delete
        
        Set rDataAll = .Range("B1", .Range("B" & Rows.Count).End(xlUp))
        If .Columns("B:B").Find(rFind, LookIn:=xlValues) Is Nothing Then
            MsgBox ("äÁèÁÕ Package ¹Õé")
            Exit Sub
        End If
    End With
    i = 13
    For Each r In rDataAll
        If r = rFind Then
            ws5.Range("d" & i).Resize(1, 4).Value = _
                r.Offset(0, 1).Resize(1, 4).Value
            If IsNumeric(VBA.Left(ws5.Range("d" & i), 1)) Then
                ws5.Range("d" & i).Resize(1, 4).Font.Bold = True
                ws5.Range("d" & i).Offset(0, -1).Resize(1, 5).Interior.Color = _
                    ws5.Range("c10").Interior.Color
               ' ws4.Range("e" & i).Font.Color = vbRed
            End If
            i = i + 1
        End If
    Next r
    With Sheets("AIA-Detail")
        .Range("c10:g11").Copy
        .Range("d" & .Rows.Count).End(xlUp).Offset(3, -1).Resize(1, 5).PasteSpecial xlPasteFormats
        With .Range("d" & .Rows.Count).End(xlUp).Offset(3, -1)
            .Resize(1, 5).PasteSpecial xlPasteFormats
            .Offset(0, 1).UnMerge
            With .Resize(1, 3)
                .Merge
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeRight).Weight = xlMedium
                .Offset(0, 1).Resize(1, 2).Merge
            End With
        End With

        Application.CutCopyMode = False
        With .Range("D" & .Rows.Count).End(xlUp).Offset(3, 0)
            .Offset(0, -1).Value = "Total"
            .Offset(0, 1).Formula = "=Sumifs(R11C:R[-1]C,R11C[-2]:R[-1]C[-2],""*.*"")"
'            .EntireRow.Delete
        End With
        .Range("e11", .Range("f" & .Rows.Count).End(xlUp)).NumberFormat = "#,##0"
'        .Range("f" & .Rows.Count).End(xlUp).NumberFormat = "#,##0"
        With .Range("f17", .Range("f" & .Rows.Count).End(xlUp)).Offset(0, -3)
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Offset(0, 1).Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Offset(0, 2).Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Offset(0, 4).Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
        End With
        With .Range("f" & .Rows.Count).End(xlUp).Offset(0, -3).Resize(1, 5).Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlMedium
        End With
    End With
            
    Application.EnableEvents = True
    ' MsgBox "Get data has finished."
    Set ws4 = Nothing
    Set rFind = Nothing
    Set rDataAll = Nothing
End Sub
wisitsakbenz
Silver
Silver
Posts: 505
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: หลังจากที่ Clickปุ่ม Cal แล้ว อยากให้ผลลัพธ์ที่ต้องการ

#5

Post by wisitsakbenz »

เรียน อาจารย์ snasui

ได้แล้วครับ ขอบคุณอาจารย์มากเลยครับ
wisitsakbenz
Silver
Silver
Posts: 505
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: หลังจากที่ Clickปุ่ม Cal แล้ว อยากให้ผลลัพธ์ที่ต้องการ

#6

Post by wisitsakbenz »

เรียน อาจารย์ snasui

อยากสอบถามเพิ่มเติมครับ คือ
1. ถ้าใส่ --> Hernia Repair (380,000) ในช่อง I7 ของ Sheet "Display" แล้วคลิกปุ่ม Cal ใน sheet "AIA"
จะแสดงผลผิดพลาด คือ เส้นเกิน และมีสีเกินครับ (อยากให้แสดงผลดัง Sheet "สิ่งที่อยากได้ AIA" และ "สิ่งที่อยากได้ Datadetail"
2.ถ้ากลับไปใส่ Cholec (235,000) หรือ Unilateral (239,000) ในช่อง I7 ของ Sheet "Display" แล้วคลิกปุ่ม Cal ใน sheet "AIA"
Row ที่ 15 จะไม่แสดงค่า และมีการ Merge Cell ใส่สี ใส่เส้น

ต้องปรับ Code อย่างไรครับ ขอบคุณครับ
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: หลังจากที่ Clickปุ่ม Cal แล้ว อยากให้ผลลัพธ์ที่ต้องการ

#7

Post by snasui »

:D ได้เขียนปรับ Code มาเองแล้วหรือไม่ เขียนไว้ว่าอย่างไรครับ
wisitsakbenz
Silver
Silver
Posts: 505
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: หลังจากที่ Clickปุ่ม Cal แล้ว อยากให้ผลลัพธ์ที่ต้องการ

#8

Post by wisitsakbenz »

เรียน อาจารย์ snasui

ขอศึกษาก่อนนะครับ หากติดขัดจะสอบถามอีกครั้งครับ
ขอบคุณครับ
Last edited by wisitsakbenz on Mon Jun 20, 2022 10:38 am, edited 1 time in total.
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: หลังจากที่ Clickปุ่ม Cal แล้ว อยากให้ผลลัพธ์ที่ต้องการ

#9

Post by snasui »

:D กรุณา Debug แล้วสังเกตมาเองว่าข้อมูลควรจะเริ่มกำหนดรูปแบบตั้งแต่บรรทัดไหน ใน Code กำหนดไว้ที่บรรทัดไหน กลับไปแก้บรรทัดนั้นให้ครอบคลุมในสิ่งที่ต้องการครับ
wisitsakbenz
Silver
Silver
Posts: 505
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: หลังจากที่ Clickปุ่ม Cal แล้ว อยากให้ผลลัพธ์ที่ต้องการ

#10

Post by wisitsakbenz »

เรียน อาจารย์ snasui

ขอศึกษาก่อนนะครับ หากติดขัดจะสอบถามอีกครั้งครับ
ขอบคุณครับ
wisitsakbenz
Silver
Silver
Posts: 505
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: หลังจากที่ Clickปุ่ม Cal แล้ว อยากให้ผลลัพธ์ที่ต้องการ

#11

Post by wisitsakbenz »

เรียน อาจารย์ snasui ครับ

อยากสอบถามเพิ่มเติมคือ
Sheet "AIA" >
- เส้นขาด
- อยากให้แสดงข้อความด้านล่างแสดง ต่อจาก "รวมราคาท้้งหมด"


หมายเหตุ : ราคาดังกล่าวไม่รวมค่าใช้จ่ายดังต่อไปนี้
* การรักษาโรคประจำตัว
* การรักษาภาวะแทรกซ้อน
* ค่ารักษา ค่าส่งตรวจ

ดังตัวอย่าง Sheet "สิ่งที่อยากได้"

ต้องปรับ Code อย่างไรครับ ขอบคุณครับ

Code: Select all

        
        With Sheets("AIA")
        .Range("c10:f10").Copy
        .Range("d" & .Rows.Count).End(xlUp).Offset(3, -1).Resize(1, 4).PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        With .Range("D" & .Rows.Count).End(xlUp).Offset(3, 0)
            .Offset(0, -1).Value = "รวมราคาท้้งหมด  " & ws4.Range("L11").Value & "  บาท"
          
                
        End With
           
    With .Range("d12", .Range("d" & .Rows.Count).End(xlUp)).Offset(0, -1)
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Offset(0, 3).Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
        End With
    End With
       
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: หลังจากที่ Clickปุ่ม Cal แล้ว อยากให้ผลลัพธ์ที่ต้องการ

#12

Post by snasui »

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

Code: Select all

'Other code
'With .Range("d12", .Range("d" & .Rows.Count).End(xlUp)).Offset(0, -1)
With .Range("c12", .Range("c" & .Rows.Count).End(xlUp))
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Offset(0, 3).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
End With
With .Range("c" & .Rows.Count).End(xlUp)
    .Offset(2, 0).Value = "หมายเหตุ : ราคาดังกล่าวไม่รวมค่าใช้จ่ายดังต่อไปนี้"
    .Offset(2, 0).Font.Bold = True
    .Offset(3, 0).Value = "* การรักษาโรคประจำตัว"
    .Offset(4, 0).Value = "* การรักษาภาวะแทรกซ้อน"
    .Offset(5, 0).Value = "* ค่ารักษา ค่าส่งตรวจ"
End With
'Other code
สิ่งที่ต้องทำความเข้าใจและใช้ให้คล่องมีดังนี้ครับ
  1. การเยื้อง Code จะต้องปรับการเข้าคู่ให้เยื้องตรงกันแม้จะไม่มีผลต่อการทำงานของ Code แต่จะสะดวกต่อการอ่านและการ Debug ลักษณะการเยื้องที่ควรเป็น เช่น

    Code: Select all

    With
      'xyz
    End With
    
    If
      'xyz
    End If
    
    For x = 0 to 10
      'xyz
    Next x
    
  2. การหาตำแหน่งที่จะ Offset
    1. การ Merge เซลล์ ค่าที่คีย์ในเซลล์จะบรรจุอยู่ในเซลล์แรกของชุดเซลล์ที่ Merge และหากการ Merge อยู่บรรทัดสุดท้าย เมื่อจะอ้างอิงหาบรรทัดสุดท้ายของข้อมูลจะต้องใช้คอลัมน์ของเซลล์ดังกล่าว
    2. วิธีการตรวจสอบหาบรรทัดสุดท้ายของข้อมูลอย่างง่าย ๆ ให้คลิกไปยังเซลล์ว่างด้านล่างข้อมูล จากนั้นกดแป้น Ctrl ค้างไว้แล้วกดแป้นลูกศรชี้ขึ้น หาก Cursor ไม่หยุดยังเซลล์สุดท้ายที่มีข้อมูลแสดงว่าคอลัมน์นั้นใช้อ้างอิงหาค่าบรรทัดสุดท้ายของข้อมูลไม่ได้
wisitsakbenz
Silver
Silver
Posts: 505
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: หลังจากที่ Clickปุ่ม Cal แล้ว อยากให้ผลลัพธ์ที่ต้องการ

#13

Post by wisitsakbenz »

เรียน อาจารย์ snasui

ได้แล้วครับ ขอบคุณอาจารย์มากเลยครับ
Post Reply