ต้องการแยกรายการ ตามที่กำหนด

[wisitsakbenz]

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

ต้องการแยกรายการโดย
1.ในกรณีที่ Procedure มี 2 รายการ ให้แยกรายการ Procedure จากช่อง B4 ให้แสดงตามผลลัพธ์ (สิ่งที่อยากได้1)
2.ในกรณีที่ Procedure มี 3 รายการ ให้แยกรายการ Procedure จากช่อง B18 ให้แสดงตามผลลัพธ์ (สิ่งที่อยากได้2)
หรือ ในกรณีที่ Procedure มี 3 รายการ ให้แยกรายการ Procedure และต่อด้วย คิดเพิ่ม

คิดเพิ่ม = ผลรวมทั้งหมดของ Procedure และ Add on

อาจารย์พอมีสูตรหรือไม่ครับ ขอบคุณครับ

[snasui]

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

1. ที่ I6 คีย์
   =IFERROR(INDEX(FILTERXML("<t><s>"&SUBSTITUTE(SUBSTITUTE($B$4&$D$3,"&","@"),"THB)","THB)</s><s>")&"</s></t>","//s"),ROWS(I$6:I6)),"")
   Enter > Copy ลงด้านล่าง
2. ที่ F6 คีย์
   =IF(I6="","",IF(I6="คิดเพิ่ม",ROWS(F$6:F6)&"."&I6,IF(LEFT(I6)="2",SUBSTITUTE(I6,"@","&"),LEFT(I6,FIND("(",I6)-2))))
   Enter > Copy ลงด้านล่าง
3. ที่ G6 คีย์
   =IF(F6="","",IF(I6="คิดเพิ่ม",SUM($D$4:$D$8),LEFT(RIGHT(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(I6,"Package",""),"(",REPT(" ",20)),"THB)",""),20),20)+0))
   Enter > Copy ลงด้านล่าง
4. ที่ I20 คีย์
   =IFERROR(INDEX(FILTERXML("<t><s>"&SUBSTITUTE(SUBSTITUTE($B$18&$D$17,"&","@"),"THB)","THB)</s><s>")&"</s></t>","//s"),ROWS(I$20:I20)),"")
   Enter > Copy ลงด้านล่าง
5. ที่ F20 คีย์
   =IF(I20="","",IF(I20="คิดเพิ่ม",ROWS(F$20:F20)&"."&I20,IF(LEFT(I20)="2",SUBSTITUTE(I20,"@","&"),LEFT(I20,FIND("(",I20)-2))))
   Enter > Copy ลงด้านล่าง
6. ที่ G20 คีย์
   =IF(F20="","",IF(I20="คิดเพิ่ม",SUM($D$18:$D$23),LEFT(RIGHT(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(I20,"Package",""),"(",REPT(" ",20)),"THB)",""),20),20)+0))
   Enter > Copy ลงด้านล่าง

[wisitsakbenz]

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

ได้แล้วครับ แต่อยากเพิ่มเติมในตัวอย่างที่ 3 และ 4 คือ
ในกรณีที่ Add on มีรายการที่ขึ้นต้นคำว่า Prothsthesis หรือ Implant จะไม่รวมกับ "คิดเพิ่ม"
ถ้ามี Prothsthesis 2 รายการ จะนำมารวมกันเป็น 1 รายการ
ถ้ามี Implant 2 รายการ จะนำมารวมกันเป็น 1 รายการ
ดังตัวอย่าง (สิ่งที่อยากได้3)
หรือมีแค่ รายการที่ขึ้นต้นคำว่า Prothsthesis หรือ Implant ตัวอย่าง (สิ่งที่อยากได้4)

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

[snasui]

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

1. ที่ I33 คีย์
   =IFERROR(INDEX(FILTERXML("<t><s>"&SUBSTITUTE(SUBSTITUTE($B$31&IF(COUNTIFS($B$34:$B$40,"Prot*"),"Prothsthesis (THB)","")&IF(COUNTIFS($B$34:$B$40,"Impl*"),"Implant (THB)","")&$D$30,"&","@"),"THB)","THB)</s><s>")&"</s></t>","//s"),ROWS(I$33:I33)),"")
   Enter > Copy ลงด้านล่าง
2. ที่ F33 คีย์
   =IF(I33="","",IF(ISERR(LEFT(I33)+0),ROWS(F$33:F33)&"."&SUBSTITUTE(I33," (THB)",""),IF(LEFT(I33)="2",SUBSTITUTE(I33,"@","&"),LEFT(I33,FIND("(",I33)-2))))
   Enter > Copy ลงด้านล่าง
3. ที่ G33 คีย์
   =IF(F33="","",IF(I33="คิดเพิ่ม",SUM($D$31:$D$40)-SUM(SUMIFS(G$32:G32,F$32:F32,{"*Prot*","*Impl*"})),IF(COUNT(SEARCH({"Prot","Impl"},F33)),SUMIFS($D$31:$D$40,$B$31:$B$40,MID(F33,3,20)&"*"),LEFT(RIGHT(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(I33,"Package",""),"(",REPT(" ",20)),"THB)",""),20),20)+0)))
   Enter > Copy ลงด้านล่าง
4. ที่ I49 คีย์
   =IFERROR(INDEX(FILTERXML("<t><s>"&SUBSTITUTE(SUBSTITUTE($B$47&IF(COUNTIFS($B$50:$B$54,"Prot*"),"Prothsthesis (THB)","")&IF(COUNTIFS($B$50:$B$54,"Impl*"),"Implant (THB)","")&$D$46,"&","@"),"THB)","THB)</s><s>")&"</s></t>","//s"),ROWS(I$49:I49)),"")
   Enter > Copy ลงด้านล่าง
5. ที่ F49 คีย์
   =IF(I49="","",IF(ISERR(LEFT(I49)+0),ROWS(F$49:F49)&"."&SUBSTITUTE(I49," (THB)",""),IF(LEFT(I49)="2",SUBSTITUTE(I49,"@","&"),LEFT(I49,FIND("(",I49)-2))))
   Enter > Copy ลงด้านล่าง
6. ที่ G49 คีย์
   =IF(F49="","",IF(I49="คิดเพิ่ม",SUM($D$47:$D$54)-SUM(SUMIFS(G$48:G48,F$48:F48,{"*Prot*","*Impl*"})),IF(COUNT(SEARCH({"Prot","Impl"},F49)),SUMIFS($D$47:$D$54,$B$47:$B$54,MID(F49,3,20)&"*"),LEFT(RIGHT(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(I49,"Package",""),"(",REPT(" ",20)),"THB)",""),20),20)+0)))
   Enter > Copy ลงด้านล่าง

[wisitsakbenz]

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

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

[wisitsakbenz]

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

ลองใช้งานจริง ถ้ามีข้อความหลัง Package...THB มันจะตัดเป็นข้อ 2 เลย (ดังตัวอย่างที่ 4 )
หรือลองเติม B61 ใน B41 ผลที่ได้จะผิดครับ
ต้องปรับสูตรอย่างไรครับ ขอบคุณครับ

[snasui]

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

[wisitsakbenz]

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

ผมลองทำแล้วครับ แต่ยังติดปัญหาดังนี้ ครับ
ถ้า Procedure ช่อง B23
กรณีมี 1 Procedure
1.Lap diagnosis with Lap Bilat endometrioma(Use Lap Bilat Ovarian Cystectomy with Adhesiolysis (Package 4,600 THB)
จะแสดงผลดังตัวอย่าง (F42)

กรณีมี 2 Procedure
1.Explore lap Myomectomy (Package 5,500 THB) with Multiple Myomectomy 2. Ovarian cystectomy
จะแสดงผลดังตัวอย่าง (สิ่งที่อยากได้)

กรณีมี 3 Procedure
1.Dilation & Curettage (1 Day) (Package 420 THB) 2.Resection (Package 590 THB) 3.Diagnostic Hysteroscopy
จะแสดงผลดังตัวอย่าง (F47)

ในกรณีที่ DF (B25:B27) มีการคิดเพิ่ม จะแสดงในรายการ (สิ่งที่อยากได้) ถ้าไม่มีการคิดจะไม่แสดง
ในกรณีที่มี Prothsthesis หรือ Implant หรือมีทั้ง 2 อย่าง จะแสดงในรายการ (สิ่งที่อยากได้) ถ้าไม่มีการคิดจะไม่แสดง
ในกรณีที่มี ค่าใช้จ่ายก่อนทำงาน จะแสดงในรายการ (สิ่งที่อยากได้) ถ้าไม่มีการคิดจะไม่แสดง
ส่วนที่เหลือจะเป็นในส่วนของ Other Charge
โดยอยากให้ Other Charges แสดงก่อน ค่าใช้จ่ายก่อนทำงาน

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

[wisitsakbenz]

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

ขอเพิ่มเติมคือ
กรณีที่ใช้ Package
Special DF จะแสดงในกรณีที่ใน Package มีราคาอยู่แล้ว (C25:C27) แต่มีการคิดเพิ่ม (D25:D27) แต่ถ้าไม่มี (D25:D27) จะไม่แสดง

กรณีที่ไม่ใช่ Package
1.Lap diagnosis with Lap Bilat endometrioma(Use Lap Bilat Ovarian Cystectomy with Adhesiolysis
จะแสดงผลดังตัวอย่าง (F56)

[snasui]

จากตัวอย่างที่แนบมามีหลายรูปแบบและมีไม่ครบชุด อาจจะมี DF หรือ Add on หรือไม่ก็ได้ งานลักษณะนี้ไม่เหมาะที่จะใช้สูตรเข้าไปจัดการ ควรเขียนมาเป็น VBA มากกว่า ลองเขียนมาเองก่อน ติดตรงไหนค่อยถามกันต่อครับ

[wisitsakbenz]

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

อาจารย์พอมีตัวอย่างหรือไม่ครับ
ทางผมไม่ค่อยมีความรู้เรื่อง vba อาจารย์พอจะชี้แนะได้หรือไม่ครับ ขอบคุณครับ

[snasui]

ตัวอย่างตรง ๆ กับงานเช่นนี้แบบสำเร็จรูปไม่มีครับ

ต้องศึกษาเอาจากตัวอย่างและประเด็นอื่น ๆ เทียบเคียง แก้ไปทีละปัญหา ประเด็นปัญหาต่าง ๆ ในฟอรัมนี้มีจำนวนมาก ลองค่อย ๆ ศึกษา หากหาไม่เจอก็ยังมีแหล่งอื่น ๆ ใน Internet เช่น StackOverflow เป็นต้น

[wisitsakbenz]

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

ผมลองเขียน Code แต่ยังติดปัญหาอยู่ครับ
Sheet Input จะเป็นหน้ากรอกข้อมูล , Sheet Forms จะเป็นหน้าแสดงผล
1.ในส่วนของ Procedure อยากให้แยกข้อมูลตามสิ่งที่อยากได้
2.ส่วนของ Special DF, Prothsthesis, Implant และ Other Charges อยากให้แต่ละหัวข้อรวมกันเลย
หมายเหตุ อยากให้แสดงลำดับหัวข้อด้วย (ตามสิ่งที่อยากได้)
ต้องปรับ Code อย่างไรครับ ขอบคุณครับ

Code: Select all

 

Private Sub CommandButton1_Click()


'Define abbreviations for worksheets
    Dim WI As Worksheet
    Dim WF As Worksheet
    Set WI = Worksheets("Input")
    Set WF = Worksheets("Forms")
    
        HeadingRow1 = WF.Range("FormsFirstLine1").Row
    CurrentRow1 = HeadingRow1
    
                    For Each AmountCell1 In WI.Range("inputProcedure").Cells
        If AmountCell1 <> "" Then
            WF.Cells(HeadingRow1, 6) = ""
            CurrentRow1 = CurrentRow1 + 1
            WF.Cells(CurrentRow1, 1) = AmountCell1
        End If
    Next
    
            For Each AmountCell1 In WI.Range("InputDoctorfree").Cells
        If AmountCell1 <> "" Then
            WF.Cells(HeadingRow1, 6) = ""
            CurrentRow1 = CurrentRow1 + 1
            WF.Cells(CurrentRow1, 1) = "Specail DF"
            WF.Cells(CurrentRow1, 6) = Application.WorksheetFunction.Sum(AmountCell1.Offset(0, 1))
       
        End If
    Next
    
                For Each AmountCell1 In WI.Range("InputProthsthesis").Cells
        If AmountCell1 <> "" Then
            WF.Cells(HeadingRow1, 6) = ""
            CurrentRow1 = CurrentRow1 + 1
            WF.Cells(CurrentRow1, 1) = "Prothsthesis"
            WF.Cells(CurrentRow1, 6) = Application.WorksheetFunction.Sum(AmountCell1.Value)

        End If
    Next
    
        
                For Each AmountCell1 In WI.Range("InputImplant").Cells
        If AmountCell1 <> "" Then
            WF.Cells(HeadingRow1, 6) = ""
            CurrentRow1 = CurrentRow1 + 1
            WF.Cells(CurrentRow1, 1) = "Implant"
            WF.Cells(CurrentRow1, 6).Formula = Application.WorksheetFunction.Sum(AmountCell1.Value)

        End If
    Next
                For Each AmountCell1 In WI.Range("InputOther").Cells
        If AmountCell1 <> "" Then
            WF.Cells(HeadingRow1, 6) = ""
            CurrentRow1 = CurrentRow1 + 1
            WF.Cells(CurrentRow1, 1) = "Other Charges"
            WF.Cells(CurrentRow1, 6) = Application.WorksheetFunction.Sum(AmountCell1.Text)
       
        End If
    Next
    
                    For Each AmountCell1 In WI.Range("InputIncure").Cells
        If AmountCell1 <> "" Then
            WF.Cells(HeadingRow1, 6) = ""
            CurrentRow1 = CurrentRow1 + 1
            WF.Cells(CurrentRow1, 1) = AmountCell1.Offset(0, -7)
            WF.Cells(CurrentRow1, 6) = AmountCell1.Text
       
        End If
    Next
    
        Do While CurrentRow1 < WF.Range("FormsLastLine1").Row
        CurrentRow1 = CurrentRow1 + 1
        WF.Cells(CurrentRow1, 1) = ""
        WF.Cells(CurrentRow1, 5) = ""
        WF.Cells(CurrentRow1, 6) = ""
   Loop
    

End Sub

[snasui]

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

Code: Select all

Sub Test()
    Dim rall As Range
    Dim r As Range, i As Integer
    Dim j As Integer
    Dim arr2 As Variant
    Dim s As String
    Dim d As Object
    
    Set d = CreateObject("Scripting.Dictionary")
    With Worksheets("Forms")
        Set tg = .Range("i5")
        Set rall = .Range("a5", .Range("a" & .Rows.Count).End(xlUp))
        For Each r In rall
            If i = 0 Then
                arr2 = VBA.Split(VBA.Replace(VBA.Replace(r.Value, "2.", "|2."), "3.", "|3."), "|")
                For j = 0 To UBound(arr2)
                    s = VBA.Replace(arr2(j), "THB)", "")
                    s = VBA.Replace(VBA.Trim(s), " ", String(20, " "))
                    s = VBA.Right(s, 20)
                    If IsNumeric(VBA.Right(s, 1)) Then
                        .Range("i5").Offset(i, 0) = arr2(j)
                        .Range("i5").Offset(i, 1) = CLng(s)
                    Else
                       .Range("i5").Offset(i, 0) = arr2(j)
                    End If
                    i = i + 1
                Next j
            Else
                If Not d.exists(r.Value) Then
                    d.Add Key:=r.Value, Item:=r.Offset(0, 1).Value
                Else
                    d.Item(r.Value) = d.Item(r.Value) + r.Offset(0, 1).Value
                End If
            End If
        Next r
        For Each itm In d.keys
            .Range("i5").Offset(i, 0) = i + 1 & "." & itm
            .Range("i5").Offset(i, 1) = d.Item(itm)
            i = i + 1
        Next itm
    End With
End Sub

[wisitsakbenz]

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

ขอโทษที่ตอบช้านะครับ
ต้องลอง Test ระบบด้วย ตอนนี้ใช้งานได้แล้วครับ
ขอบคุณอาจารย์มากเลยครับ