excel数据生成对象元素数组 VBA

平时写echarts要用到很多数据，对象元素数组数据。很多时候从外面复制的数据不是js的对象元素数组格式的，要手动弄成对象元素数组。

现在想法是一列数复制进excel里点击生成对象元素数组导出txt文件直接可以用了。

以下为office2016的excel为例。

开发工具

打开excel。看菜单栏，看有没有开发工具，如果没有。点文件--选项--自定义功能区--右边，主选项卡 勾上开发工具，确定。

 

现在做个操作AB列生成对象元素数组。

开始添加按钮；

 

添加说明

点击开发工具--插入，ActiveX控件，

选字母A那个标签控件，点了后在下面空白处点击出现一个小框里面写着Label1，对着Label1右键弹出菜单，标签对象--编辑，写上说明文字：转对象元素数组导到txt。

 

添加按钮

再点插入，标签旁边的选项按钮。添加到下面，右键OptionButton1，选项按钮对象--编辑，改为：AB列为数组一个元素。框大小可随意拉伸。

同样操作再添加个：AB列每行为数组一个元素选项；

再插入第一个命令按钮，一样编辑上面的文字改为：确定。

如图：

写VBA代码实现

双击确定按扭或者右键确定按钮--查看代码；弹出一个代码编辑窗,里面代码是这样。

•  
•  
•  

Private Sub CommandButton1_Click()End Sub

 

取到选项按钮值

要先判断选项选到了那个才运行转对象元素数组转出代码；

在里面输入如下获取是否选中AB列为数组一个元素选项（OptionButton1）：

•  
•  
•  
•  

Private Sub CommandButton1_Click()ob1 = OptionButton1.ValueMsgBox (ob1)End Sub

点回表格界面，点上面设计模式，取消设计模式，然后上面选中AB列为数组一个元素再点确定，弹出True。选其他两项时点确定弹出False。说明选中就是True。另一个也可得了。

 

写处理函数

AB列为数组一个元素选项运行的代码：

•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  

Sub arr_objAB():Dim fs, fPath = ThisWorkbook.PathSet fs = CreateObject("Scripting.FileSystemObject")Set f = fs.OpenTextFile(Path & "\arrobj.txt", 2, True)f.write ("[{")"A列B列For aRow = 1 To Sheet1.Range("A65536").End(xlUp).Rowf.write ("""" & Cells(aRow, 1).Text & """")f.write (":")If IsNumeric(Cells(aRow, 2).Text) Thenf.write (Cells(aRow, 2).Text)Elsef.write ("""" & Cells(aRow, 2).Text & """")End IfIf aRow <> Sheet1.Range("A65536").End(xlUp).Row Thenf.write (",")End IfNext aRowf.write ("}]")f.CloseEnd Sub

Path = ThisWorkbook.Path，取到文件当前路径。

CreateObject("Scripting.FileSystemObject")，创建操作文件对象

Set f = fs.OpenTextFile(Path & "\arrobj.txt", 2, True)，引用OpenTextFile打开文件方法。

object.OpenTextFile(filename[,iomode[,create[,format]]])

iomode

ForReading 1 打开一个只读文件。不能对此文件进行写操作

ForWriting 2 打开一个可读写操作的文件，并删除原有文本内容

ForAppending 8 打开一个文件并写到文件的尾部

create 可选的。Boolean 值，它表示如果指定的 filename 不存在是否可以创建一个新文件。如果创建新文件，其值为 True。若不创建文件其值为 False。缺省值为 False。

f.write ("[{")，向arrobj.txt写入内容;

还有个f.writeline()，一行行写入。这里不用。

For aRow = 1 To Sheet1.Range("A65536").End(xlUp).Row，从后往上检查取到有值的行数；

f.write ("""" & Cells(aRow, 1).Text & """")，加双引号写入A列第 aRow行的内容。

•  
•  
•  
•  
•  

If IsNumeric(Cells(aRow, 2).Text) Thenf.write (Cells(aRow, 2).Text)Elsef.write ("""" & Cells(aRow, 2).Text & """")End If

判断B列值是否为数字，如果是数字就不用双引号写入。

•  
•  
•  

If aRow <> Sheet1.Range("A65536").End(xlUp).Row Thenf.write (",")End If

 

判断如果不是最后一个元素，写入逗号“，”。

Next aRow，循环上面步骤。

f.Close，关闭文件操作。

再写一个函数，AB列每行为数组一个元素选项。

•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  

Sub arr_obj():Dim fs, fPath = ThisWorkbook.PathSet fs = CreateObject("Scripting.FileSystemObject")Set f = fs.OpenTextFile(Path & "\arrobj.txt", 2, True)f.write ("[")"A列B列For aRow = 1 To Sheet1.Range("A65536").End(xlUp).Rowf.write ("{")f.write ("""" & Cells(aRow, 1).Text & """")f.write (":")If IsNumeric(Cells(aRow, 2).Text) Thenf.write (Cells(aRow, 2).Text)Elsef.write ("""" & Cells(aRow, 2).Text & """")End Iff.write ("}")If aRow <> Sheet1.Range("A65536").End(xlUp).Row Thenf.write (",")End IfNext aRowf.write ("]")f.CloseEnd Sub

和上面函数类似，区别只在加入“{“，”}”的位置。

还有运行完打开TXT文件代码。

•  
•  

fname = Path & "\arrobj.txt"Shell "Notepad.exe " & fname, vbNormalFocus

Shell "Notepad.exe " & fname, vbNormalFocus，注意notepad.exe后面有一个空格。记事本以普通窗口模式打开arr.txt文件。这句放到上面处理函数后面。

转对象元素数组完整代码

•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  
•  

Private Sub CommandButton1_Click()ob1 = OptionButton1.Valueob2 = OptionButton2.ValuePath = ThisWorkbook.Pathfname = Path & "\arrobj.txt"If ob1 = "True" Thenarr_objABShell "Notepad.exe " & fname, vbNormalFocusEnd IfIf ob2 = "True" Thenarr_objShell "Notepad.exe " & fname, vbNormalFocusEnd IfEnd SubSub arr_objAB():Dim fs, fPath = ThisWorkbook.PathSet fs = CreateObject("Scripting.FileSystemObject")Set f = fs.OpenTextFile(Path & "\arrobj.txt", 2, True)f.write ("[{")"A列B列For aRow = 1 To Sheet1.Range("A65536").End(xlUp).Rowf.write ("""" & Cells(aRow, 1).Text & """")f.write (":")If IsNumeric(Cells(aRow, 2).Text) Thenf.write (Cells(aRow, 2).Text)Elsef.write ("""" & Cells(aRow, 2).Text & """")End IfIf aRow <> Sheet1.Range("A65536").End(xlUp).Row Thenf.write (",")End IfNext aRowf.write ("}]")f.CloseEnd SubSub arr_obj():Dim fs, fPath = ThisWorkbook.PathSet fs = CreateObject("Scripting.FileSystemObject")Set f = fs.OpenTextFile(Path & "\arrobj.txt", 2, True)f.write ("[")"A列B列For aRow = 1 To Sheet1.Range("A65536").End(xlUp).Rowf.write ("{")f.write ("""" & Cells(aRow, 1).Text & """")f.write (":")If IsNumeric(Cells(aRow, 2).Text) Thenf.write (Cells(aRow, 2).Text)Elsef.write ("""" & Cells(aRow, 2).Text & """")End Iff.write ("}")If aRow <> Sheet1.Range("A65536").End(xlUp).Row Thenf.write (",")End IfNext aRowf.write ("]")f.CloseEnd Sub

要另存为xlsm格式的文件并启用宏。

 

试用如图：