Copy dữ liệu từ file Json sang Excel

luu.nguyen21 · 8/10/21

Thân chào anh/em,
Nhờ ae cao tay chỉ dùm mình cách copy dữ liệu từ file json sang file excel. (file mẫu trong tệp đính kèm) cám ơn ae rất nhiều!

Maika8008 · 8/10/21

luu.nguyen21 đã viết:
Thân chào anh/em,
Nhờ ae cao tay chỉ dùm mình cách copy dữ liệu từ file json sang file excel. (file mẫu trong tệp đính kèm) cám ơn ae rất nhiều!

Dùng sub này

Rich (BB code):

Sub GetFileText_utf8()

Dim st As Object
Dim sPathname As String, sText As String
Dim A() As String, Cline As Double, B() As String
Dim i As Long

    Set st = CreateObject("ADODB.Stream")
    sPathname = "D:\TestGPE\Import Json\" & "Customer_info.json"  'Sửa lại đường dẫn cho phù hợp
    st.Charset = "utf-8"
    st.Open
    st.LoadFromFile (sPathname)
    sText = st.ReadText(-1)  'Doc characters (Dung tham so -1 doc All file)
    A = Split(sText, vbLf)
    Cline = UBound(A) + 1
    ReDim B(1 To Cline, 1 To 1)
   
    Application.ScreenUpdating = False
    For i = 0 To Cline - 1
        B(i + 1, 1) = A(i)
    Next i
    Sheet2.Range("A1:A100000").ClearContents
    Sheet2.Range("A1").Resize(Cline, 1) = B
    st.Close
    Set st = Nothing
    Application.ScreenUpdating = True

End Sub

luu.nguyen21 · 8/10/21

Maika8008 đã viết:

Dùng sub này

Rich (BB code):

Sub GetFileText_utf8()

Dim st As Object
Dim sPathname As String, sText As String
Dim A() As String, Cline As Double, B() As String
Dim i As Long

    Set st = CreateObject("ADODB.Stream")
    sPathname = "D:\TestGPE\Import Json\" & "Customer_info.json"  'Sửa lại đường dẫn cho phù hợp
    st.Charset = "utf-8"
    st.Open
    st.LoadFromFile (sPathname)
    sText = st.ReadText(-1)  'Doc characters (Dung tham so -1 doc All file)
    A = Split(sText, vbLf)
    Cline = UBound(A) + 1
    ReDim B(1 To Cline, 1 To 1)
  
    Application.ScreenUpdating = False
    For i = 0 To Cline - 1
        B(i + 1, 1) = A(i)
    Next i
    Sheet2.Range("A1:A100000").ClearContents
    Sheet2.Range("A1").Resize(Cline, 1) = B
    st.Close
    Set st = Nothing
    Application.ScreenUpdating = True

End Sub

Bạn ơi mình muốn import vào file excel sẽ hiển thị theo dòng và cột như bên file excel mẫu đính kèm
Nhờ bạn xem dùm mình. cám ơn bạn rất nhiều

Maika8008 · 8/10/21

luu.nguyen21 đã viết:
Bạn ơi mình muốn import vào file excel sẽ hiển thị theo dòng và cột như bên file excel mẫu đính kèm
Nhờ bạn xem dùm mình. cám ơn bạn rất nhiều
View attachment 267385

Việc này dễ hơn việc trước.

Maika8008 · 8/10/21

Gộp cả 2 việc. Tạm thời chưa có tiêu đề, dữ liệu chép ra ở H2
Nếu muốn tiêu đề thì làm tiếp, chừ tôi bận rồi

Rich (BB code):

Sub GetFileText_utf8()

Dim st As Object
Dim sPathname As String, sText As String
Dim A() As String, B() As String, Cline As Double
Dim i&, j&, k&, Dau&, Cuoi&

    Set st = CreateObject("ADODB.Stream")
    sPathname = "D:\TestGPE\Import Json\" & "Customer_info.json"
    st.Charset = "utf-8"
    st.Open
    st.LoadFromFile (sPathname)
    sText = st.ReadText(-1)  'Doc characters (Dung tham so -1 doc All file)
    A = Split(sText, vbLf)
    Cline = UBound(A) + 1
    ReDim B(1 To Cline, 1 To 7)
    j = 1
    For i = 0 To Cline - 1
        If InStr(1, A(i), """") Then
            k = k + 1
            Dau = InStr(1, A(i), ":") + 3: Cuoi = InStrRev(A(i), """")
            B(j, k) = Mid(A(i), Dau, Cuoi - Dau)
            If k = 7 Then k = 0: j = j + 1
        End If
    Next i
    st.Close
    Set st = Nothing
    Sheet2.Range("H2").Resize(j, 7) = B

End Sub

luu.nguyen21 · 8/10/21

Maika8008 đã viết:

Gộp cả 2 việc. Tạm thời chưa có tiêu đề, dữ liệu chép ra ở H2
Nếu muốn tiêu đề thì làm tiếp, chừ tôi bận rồi

Rich (BB code):

Sub GetFileText_utf8()

Dim st As Object
Dim sPathname As String, sText As String
Dim A() As String, B() As String, Cline As Double
Dim i&, j&, k&, Dau&, Cuoi&

    Set st = CreateObject("ADODB.Stream")
    sPathname = "D:\TestGPE\Import Json\" & "Customer_info.json"
    st.Charset = "utf-8"
    st.Open
    st.LoadFromFile (sPathname)
    sText = st.ReadText(-1)  'Doc characters (Dung tham so -1 doc All file)
    A = Split(sText, vbLf)
    Cline = UBound(A) + 1
    ReDim B(1 To Cline, 1 To 7)
    j = 1
    For i = 0 To Cline - 1
        If InStr(1, A(i), """") Then
            k = k + 1
            Dau = InStr(1, A(i), ":") + 3: Cuoi = InStrRev(A(i), """")
            B(j, k) = Mid(A(i), Dau, Cuoi - Dau)
            If k = 7 Then k = 0: j = j + 1
        End If
    Next i
    st.Close
    Set st = Nothing
    Sheet2.Range("H2").Resize(j, 7) = B

End Sub

cám ơn bạn rất nhiều để mình thử xem

Maika8008 · 8/10/21

Có thêm tiêu đề

Rich (BB code):

Sub GetFileText_utf8()

Dim st As Object
Dim sPathname As String, sText As String
Dim A() As String, B() As String, aTtl() As String, Cline As Double
Dim i&, j&, k&, Dau&, Cuoi&

    Set st = CreateObject("ADODB.Stream")
    sPathname = "D:\TestGPE\Import Json\" & "Customer_info.json"
    st.Charset = "utf-8"
    st.Open
    st.LoadFromFile (sPathname)
    sText = st.ReadText(-1)  'Doc characters (Dung tham so -1 doc All file)
    A = Split(sText, vbLf)
    Cline = UBound(A) + 1
    ReDim B(1 To Cline, 1 To 7)
    ReDim aTtl(1 To 7)
    j = 1
    For i = 0 To Cline - 1
        If InStr(1, A(i), """") Then
            k = k + 1
            Dau = InStr(1, A(i), ":") + 3: Cuoi = InStrRev(A(i), """")
            If j = 1 Then aTtl(k) = Mid(A(i), InStr(1, A(i), """") + 1, Dau - 5 - InStr(1, A(i), """"))
            B(j, k) = Mid(A(i), Dau, Cuoi - Dau)
            If k = 7 Then k = 0: j = j + 1
        End If
    Next i
    st.Close
    Set st = Nothing
    Sheet2.Range("H2").Resize(j, 7) = B
    Sheet2.Range("H1").Resize(1, 7) = aTtl
    Sheet2.Range("H1").Resize(1, 7).Font.Bold = True
End Sub

luu.nguyen21 · 8/10/21

Maika8008 đã viết:

Có thêm tiêu đề

Rich (BB code):

Sub GetFileText_utf8()

Dim st As Object
Dim sPathname As String, sText As String
Dim A() As String, B() As String, aTtl() As String, Cline As Double
Dim i&, j&, k&, Dau&, Cuoi&

    Set st = CreateObject("ADODB.Stream")
    sPathname = "D:\TestGPE\Import Json\" & "Customer_info.json"
    st.Charset = "utf-8"
    st.Open
    st.LoadFromFile (sPathname)
    sText = st.ReadText(-1)  'Doc characters (Dung tham so -1 doc All file)
    A = Split(sText, vbLf)
    Cline = UBound(A) + 1
    ReDim B(1 To Cline, 1 To 7)
    ReDim aTtl(1 To 7)
    j = 1
    For i = 0 To Cline - 1
        If InStr(1, A(i), """") Then
            k = k + 1
            Dau = InStr(1, A(i), ":") + 3: Cuoi = InStrRev(A(i), """")
            If j = 1 Then aTtl(k) = Mid(A(i), InStr(1, A(i), """") + 1, Dau - 5 - InStr(1, A(i), """"))
            B(j, k) = Mid(A(i), Dau, Cuoi - Dau)
            If k = 7 Then k = 0: j = j + 1
        End If
    Next i
    st.Close
    Set st = Nothing
    Sheet2.Range("H2").Resize(j, 7) = B
    Sheet2.Range("H1").Resize(1, 7) = aTtl
    Sheet2.Range("H1").Resize(1, 7).Font.Bold = True
End Sub

cám ơn bạn rất rất nhiều luôn

Copy dữ liệu từ file Json sang Excel

luu.nguyen21

Thành viên mới

File đính kèm

Maika8008

Thành viên gạo cội

luu.nguyen21

Thành viên mới

Maika8008

Thành viên gạo cội

Maika8008

Thành viên gạo cội

luu.nguyen21

Thành viên mới

Maika8008

Thành viên gạo cội

luu.nguyen21

Thành viên mới

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng