VBA HTML

Option Explicit
Sub Sample2()

Dim ADO As Object, FilePathName As String

Set ADO = CreateObject("ADODB.Stream")
FilePathName = ThisWorkbook.Path & "\Report1\" & "Data.js"

ADO.Charset = "UTF-8"
ADO.Open

Dim str As String

str = "const HCC={"
Dim g, i
For Each g In Range("B4:AM59")

Select Case True
Case g.Column = Range("B1").Column
i = i + 1
str = str & i & ":""" & g.Text
Case Else
' If InStr(g.Text, "%") > 0 Then
' str = str & "," & g.Value
' ElseIf IsNumeric(g.Text) = False Then
str = str & "," & g.Text
' Else
' str = str & "," & g.Value
' End If
If g.Column = Range("AM1").Column Then
If g.Row = 59 Then
str = str & """}"
Else
str = str & """," & vbCrLf
End If
End If
End Select


Next




ADO.WriteText str
ADO.SaveToFile FilePathName, 2
ADO.Close

End Sub

Sub Sample1()

Dim ADO As Object, FilePathName As String

Set ADO = CreateObject("ADODB.Stream")
FilePathName = ThisWorkbook.Path & "\Report1\" & "Data.js"

ADO.Charset = "UTF-8"
ADO.Open

Dim str As String

str = "const AAA={"
Dim g, i
For i = 1 To 2
str = str & i & ":["
For Each g In Range("B4:AM59")

Select Case True
Case g.Column = Range("B1").Column
str = str & "['" & g.Text & "'"
Case Else
' If InStr(g.Text, "%") > 0 Then
' str = str & "," & g.Value
' ElseIf IsNumeric(g.Text) = False Then
str = str & ",'" & g.Text & "'"
' Else
' str = str & "," & g.Value
' End If
If g.Column = Range("AM1").Column Then
If g.Row = 59 Then
str = str & "]" & vbCrLf
Else
str = str & "]," & vbCrLf
End If
End If
End Select


Next
str = str & "],"
Next
str = Left(str, Len(str) - 1)
str = str & "};" & vbCrLf



ADO.WriteText str
ADO.SaveToFile FilePathName, 2
ADO.Close

End Sub