Este fórum está sendo desativado

[ErickSant]

Prezados,
boa tarde,

Meu código abaixo, transforma algumas colunas específicas do arquivo excel em um arquivo formato Json, o código está funcionando, porém as colunas que eu desejo transformar para Json são as N, O, P, H, G, L, E. Por algum motivo o qual não estou conseguindo identificar, só está transformando as 3 primeiras colunas...

Código: Selecionar todos

Option Explicit

Sub export_in_json_format()

    Dim fs As Object
    Dim jsonfile
    Dim rangetoexport As Range
    Dim rowcounter As Long
    Dim columncounter As Long
    Dim linedata As String
    Dim UltimaLinhaAtivaE As Long
    Dim UltimaLinhaAtivaG As Long
    Dim UltimaLinhaAtivaH As Long
    Dim UltimaLinhaAtivaL As Long
    Dim UltimaLinhaAtivaN As Long
    Dim UltimaLinhaAtivaO As Long
    Dim UltimaLinhaAtivaP As Long
    Dim r1 As Range
    Dim r2 As Range
    Dim r3 As Range
    Dim r4 As Range
    Dim r5 As Range
    Dim r6 As Range
    Dim r7 As Range
    
    UltimaLinhaAtivaE = Planilha1.Cells(Planilha1.Rows.Count, 5).End(xlUp).Row
    UltimaLinhaAtivaG = Planilha1.Cells(Planilha1.Rows.Count, 7).End(xlUp).Row
    UltimaLinhaAtivaH = Planilha1.Cells(Planilha1.Rows.Count, 7).End(xlUp).Row
    UltimaLinhaAtivaL = Planilha1.Cells(Planilha1.Rows.Count, 12).End(xlUp).Row
    UltimaLinhaAtivaN = Planilha1.Cells(Planilha1.Rows.Count, 14).End(xlUp).Row
    UltimaLinhaAtivaO = Planilha1.Cells(Planilha1.Rows.Count, 15).End(xlUp).Row
    UltimaLinhaAtivaP = Planilha1.Cells(Planilha1.Rows.Count, 16).End(xlUp).Row
    
    
    Set r1 = Worksheets("Sheet1").Range("N1:N" & UltimaLinhaAtivaN)
    Set r2 = Worksheets("Sheet1").Range("O1:O" & UltimaLinhaAtivaO)
    Set r3 = Worksheets("Sheet1").Range("P1:P" & UltimaLinhaAtivaP)
    Set r4 = Worksheets("Sheet1").Range("H1:H" & UltimaLinhaAtivaH)
    Set r5 = Worksheets("Sheet1").Range("G1:G" & UltimaLinhaAtivaG)
    Set r6 = Worksheets("Sheet1").Range("L1:L" & UltimaLinhaAtivaL)
    Set r7 = Worksheets("Sheet1").Range("E1:E" & UltimaLinhaAtivaE)
    
    
    Set rangetoexport = Union(r1, r2, r3, r4, r5, r6, r7)
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    ' change dir here
    
    Set jsonfile = fs.CreateTextFile("C:\Users\erick.l.santiago\Desktop\" & "jsondata.json", True)
    
    linedata = "{""Output"": ["
    jsonfile.WriteLine linedata
    For rowcounter = 2 To rangetoexport.Rows.Count
        linedata = ""
        For columncounter = 1 To rangetoexport.Columns.Count
            linedata = linedata & """" & rangetoexport.Cells(1, columncounter) & """" & ":" & """" & rangetoexport.Cells(rowcounter, columncounter) & """" & ","
        Next
        linedata = Left(linedata, Len(linedata) - 1)
        If rowcounter = rangetoexport.Rows.Count Then
            linedata = "{" & linedata & "}"
        Else
            linedata = "{" & linedata & "},"
        End If
        
        jsonfile.WriteLine linedata
    Next
    linedata = "]}"
    jsonfile.WriteLine linedata
    jsonfile.Close
    
    Set fs = Nothing
    
    
End Sub

Precisava de ajuda de alguém mais avançado que eu para tentar corrigir isso dentro do código...

Conto com a ajuda de vocês...

Obrigado...

[osvaldomp]

Experimente:

acrescente a segunda linha abaixo

Código: Selecionar todos

Sub export_in_json_format()
 Dim i As Long, Cx As Variant  'acrescente esta linha
...

substitua estas linhas

Código: Selecionar todos

For columncounter = 1 To rangetoexport.Columns.Count
  linedata = linedata & """" & rangetoexport.Cells(1, columncounter) & """" & ":" & """" & rangetoexport.Cells(rowcounter, columncounter) & """" & ","
Next

por estas

Código: Selecionar todos

Cx = Array(1, 2, 3, -5, -6, -1, -8) 'N, O, P, H, G, L, E
For i = LBound(Cx) To UBound(Cx)
 linedata = linedata & """" & rangetoexport.Cells(1, Cx(i)) & """" & ":" & """" & rangetoexport.Cells(rowcounter, Cx(i)) & """" & ","
Next i