สอบถามเรื่องจดหมายแจ้งเตือนครับ

[niwat2811]

สอบถามผู้รู้ครับ เรื่องจดหมายแจ้งเตือน โดยมีเงื่อนไขว่าถ้ามีผู้กู้ 1 คน ผู้ค้ำ 1 คน ให้ออกหนังสือเตือนโดยมีชื่อผู้กู้ 1 ฉบับ และมีชื่อผู้กู้และผู้ค้ำ 1 ฉบับ
ถ้ามีผู้กู้ 1 คน และผู้ค้ำ 2 คน ให้ออกหนังสือเตือนโดยมีชื่อผู้กู้ 1 ฉบับ และมีชื่อผู้กู้และผู้ค้ำคนที่หนึ่ง 1 ฉบับ และมีชื่อผู้กู้และผู้ค้ำคนที่สอง 1 ฉบับ
ตัวอย่างข้อมูลที่ต้องการตามไฟล์แนบ (Code อยู่ใน Module 1) ขอบคุณครับ

[snasui]

ช่วยทำผลลัพธ์ที่ต้องการมาทั้งสองกรณี จะได้เห็นว่าข้อมูลต้นทางเป็นอย่างไร ต้องการคำตอบเป็นอย่างไร จะได้เข้าใจตรงกันครับ

[niwat2811]

ผลลัพธ์ที่ต้องการคือตัวอย่างตารางด้านขวามือครับ

[niwat2811]

โดยการแยกตามเลขที่บัญชี เช่น บัญชี 11111 ผู้กู้ชื่อ นายทดสอบ ผู้ค้าชื่อ นายชอบกู้ ก็ให้ออกใบเตือนมาสองใบ โดยใบแรกเป็นชื่อ นายทดสอบ ที่ช่องผู้กู้ ส่วนอีกใบเป็นชื่อนายทดสอบ ที่ช่องผู้กู้และนายชอบกู้ ที่ช่องผู้ค้ำ ส่วนบัญชี 22222 ผู้กู้ชื่อ นายเอ แต่มีผู้ค้ำสองคนคือนายบีและนายซี ก็ให้ออกใบเตือนมาสามใบ โดยใบแรกเป็นชื่อนายเอ ที่ช่องผู้กู้ ใบที่สองเป็นชื่อนายเอ ที่ช่องผู้กู้และชื่อนายบี ที่ช่องผู้ค้ำ ใบที่สามเป็นชื่อนายเอ ที่ช่องผู้กู้และชื่อนายซี ที่ช่องผู้ค้ำ ขอบคุณครับ

[snasui]

บัญชี 11111, 22222 ดูจากชีตไหน เซลล์ไหน ช่วยอธิบายมาเป็นลำดับผู้อ่านจะได้ทราบว่ากำลังจะทำอะไรและต้องการคำตอบเป็นอย่างไร เช่นนี้เป็นต้นครับ

แรกเริ่มเดิมทีตารางด้านซ้ายมีกี่ตาราง จากไหนถึงไหน

ตารางด้านขวามือที่กล่าวถึงมีกรณีใด จากพื้นที่ใดถึงพื้นที่ใด การจะเป็นตารางด้านขวามือนั้นนำตารางจากไหนหรือสร้างขึ้นมาใหม่ วางข้อมูลใด ตรงเซลล์ไหน ฯลฯ ครับ

[niwat2811]

บัญชี 11111 กับบัญชี 22222 อยู่ในชีท DATA ครับ ตารางด้านขวาเป็นตัวอย่างที่ถูกต้องและต้องการให้แสดงในตารางด้านซ้ายครับ สรุปก็คือตารางด้านซ้ายจะมีการสร้างตารางไว้อยู่แล้ว เพียงแต่ว่าต้องการนำข้อมูลจากชีท DATA มาวางให้ตรงตามเงื่อนไขดังที่กล่าวไปแล้วด้านบนครับ ตารางด้านขวาเป็นเพียงตัวอย่างผลลัพธ์ที่อยากให้แสดงที่ตารางด้านซ้ายครับท่านอาจารย์

[snasui]

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

Code: Select all

Sub test0()
    Dim rall As Range, r As Range, l As Long, k As Long, m As Integer
    Dim d As Object, itm As Object, a As Variant, b As Range
    
    Set d = CreateObject("Scripting.Dictionary")
    
    With Sheets("DATA")
        Set rall = .Range("b2", .Range("b" & .Rows.Count).End(xlUp))
        For Each r In rall
            If Not d.exists(CStr(r.Value)) Then
                d.Add Key:=CStr(r.Value), Item:=CStr(r.Value)
            End If
        Next r
        a = d.items
        For l = 0 To d.Count - 1
            If l = 0 Then
                Set b = Sheets("จดหมาย").Range("d12")
            Else
                Set b = b.Offset(15, 0)
            End If
            m = Application.Match(CLng(a(l)), rall, 0) + 1
            k = Application.CountIf(rall, a(l))
            If k = 1 Then
                b.Value = .Cells(m, "c").Value
                
                Set b = b.Offset(15, 0)
                b.Value = .Cells(m, "c").Value
                b.Offset(1, 0).Value = .Cells(m, "d").Value
            ElseIf k = 2 Then
                b.Value = .Cells(m, "c").Value
                
                Set b = b.Offset(15, 0)
                b.Value = .Cells(m, "c").Value
                b.Offset(1, 0).Value = .Cells(m, "d").Value
                
                Set b = b.Offset(15, 0)
                b.Value = .Cells(m, "c").Value
                b.Offset(1, 0).Value = .Cells(m + 1, "d").Value
            End If
        Next l
    End With
End Sub

[niwat2811]

เรียนท่านอาจารย์ Code ที่ให้มาสามารถใช้ได้ตรงตามความต้องการครับ