แปลงข้อมูลเป็น Json ให้เป็นไปตามไฟล์แนบ

[wisitsakbenz]

เรียน อาจารย์ อาจารย์ logic , อาจารย์ snasui และอาจารย์ Bo_ry

ขอรบกวนอีกครั้งครับ ทาง User ต้องการเปลี่ยนแปลงผลลัทธ์ ซึ่งทางผมลองปรับ Code แล้ว แต่ยังไม่ได้
ไม่ทราบว่าต้องปรับ Code อย่างไรครับ ขอบคุณครับ

Code: Select all

Sub cJs()
Dim ra As Range, rs As Range, r As Range
Dim h$, q$, l$, f$, i%, j%, k%, a(), b(), c()
q = Chr(34): f = vbLf
Set ra = [c:c].SpecialCells(xlCellTypeConstants)
For i = 1 To ra.Areas.Count
    Set rs = ra.Areas(i)
    h = q & Cells(rs(1).Row - 1, 1) & q & ":[" & f & "{"
    k = 0
    For Each r In rs
        If Val(r) Then
            ReDim Preserve a(k), b(k)
            l = q & r.Offset(0, -2) & q & ":"
        
         a(k) = l & q & r.Offset(0, -1) & q: b(k) = l & q & r & q
            k = k + 1
        End If
    Next r
    If k > 0 Then
        ReDim Preserve c(j)
        c(j) = h & f & Join(a, "," & f) & f & "}," & f & f & _
            h & f & Join(b, "," & f) & "}"
        j = j + 1
    End If
Next i
[f15] = "{" & Join(c, "," & f & f) & f & "}"

End Sub

[wisitsakbenz]

เรียน อาจารย์ logic , อาจารย์ snasui และอาจารย์ Bo_ry

ผมลองปรับได้แล้วนะครับ ขอบคุณครับ

[wisitsakbenz]

เรียน อาจารย์ อาจารย์ logic , อาจารย์ snasui และอาจารย์ Bo_ry ครับ

ขอรบกวนอีกครั้งครับ ทาง User ต้องการเปลี่ยนแปลงผลลัทธ์ โดยจะให้แสดงค่าที่เป็น 0 ด้วย (ตัวอย่างตามไฟล์แนบ)
ไม่ทราบว่าต้องปรับ Code อย่างไรครับ ขอบคุณครับ

Code: Select all

Dim ra As Range, rs As Range, r As Range
Dim h$, q$, l$, f$, i%, j%, k%, a(), b(), c()
q = Chr(34): f = vbLf
Set ra = [d:d].SpecialCells(xlCellTypeConstants)
For i = 1 To ra.Areas.Count
    Set rs = ra.Areas(i)
    h = q & Cells(rs(1).Row - 1, 1) & q & ":[" & f & "{"
    k = 0
    For Each r In rs
        If Val(r) Then
            ReDim Preserve a(k), b(k)
            l = q & r.Offset(0, -3) & q & ":"
        
         a(k) = l & q & r.Offset(0, -2) & q: b(k) = l & q & r & q
            k = k + 1
        End If
    Next r
    If k > 0 Then
        ReDim Preserve c(j)
        c(j) = h & f & Join(a, "," & f) & f & "}," & f & _
            "{" & f & Join(b, "," & f) & f & "}" & "]"
        j = j + 1
    End If
Next i
[f15] = "{" & Join(c, "," & f & f) & f & "}"

[snasui]

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

Code: Select all

'Other code
'If Val(r) Then
ReDim Preserve a(k), b(k)
l = q & r.Offset(0, -3) & q & ":"

a(k) = l & q & r.Offset(0, -2) & q: b(k) = l & q & r & q
k = k + 1
'End If
'Other code

[wisitsakbenz]

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

ตัวอย่างผลลัพธ์ที่ได้

"Histopathology":"110",
"Lab Investigation":"111",
"Molecular Lab":"0",
"Pap Smear":"0"

อยากให้ค่าที่เป็น 0 โชว์เป็น ""

"Histopathology":"110",
"Lab Investigation":"111",
"Molecular Lab":"",
"Pap Smear":""

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

[logic]

เปลี่ยนตรง l & q & r & q เป็น l & IIf(Val(r), q & r & q, q & q) ครับ

[wisitsakbenz]

เรียน อาจารย์ snasui และ อาจารย์ logic

ได้แล้วครับ ขอบคุณอาจารย์ทั้ง 2 ท่านมากนะครับ