由于策划计算的表格结构和程序实际使用的数据表结构不一定一致,因此有时候经常需要做数据转化。把策划自己的表格转成程序需要的格式,然后再导入数据库。这次也是策划有个表,里面有多个字段分别表示多个属性,但是程序考虑到通用,不想一个属性增加一个字段,因此想用一个字段,然后采用JSON格式来表示所有属性。
因此,帮策划写了个VBA实现多个字段合并成JSON的。这个VBA可以通过Ctrl表格来配置:
源表名:策划表的名字
目标表名:程序表的名字
字段映射:程序表的字段名对应策划表的字段名。目前支持字段合并(即把策划表里面的多个字段使用JSON合并成程序表需要的一个字段)。字段映射的行数和程序表的字段数量一样。
Sub 按钮1_Click()
SearchColumn = 1
CTRL_TABLE_NAME = "Ctrl"
TotalRow = CountRow(CTRL_TABLE_NAME)
SOURCE_TABLE = GetValueByKey(CTRL_TABLE_NAME, "源表名", TotalRow, SearchColumn)
TARGET_TABLE = GetValueByKey(CTRL_TABLE_NAME, "目标表名", TotalRow, SearchColumn)
Dim srcFieldsArr() As String
fieldNum = 0
Set dict = CreateObject("Scripting.Dictionary")
'Set dict = CreateObject("Scripting.Dictionary")
' 源表格总行数
SrcTableRowCount = CountRow(SOURCE_TABLE)
For Row = 1 To TotalRow
If Cells(Row, 1) = "字段映射" Then
fieldNum = fieldNum + 1
ReDim Preserve srcFieldsArr(fieldNum)
srcFieldsArr(fieldNum) = Cells(Row, 2)
totalColumn = CountColumn(CTRL_TABLE_NAME, Row)
Dim arr() As String '存放目标表格列
ReDim arr(1 To totalColumn - 2)
For i = 3 To totalColumn
arr(i - 2) = Cells(Row, i)
Next
dict.Add fieldNum, arr
End If
Next Row
'源表格列名和索引的映射
Set SrcRowNameToIndex = CreateObject("Scripting.Dictionary")
For Column = 1 To CountColumn(SOURCE_TABLE, 1)
SrcRowNameToIndex.Add Worksheets(SOURCE_TABLE).Cells(1, Column).Value, Column
Next Column
' 处理数据
For Row = 2 To SrcTableRowCount
For i = 1 To fieldNum
arr = dict(i)
If UBound(arr) = 1 Then
SrcColumnIndex = SrcRowNameToIndex(arr(1))
Worksheets(TARGET_TABLE).Cells(Row, i) = Worksheets(SOURCE_TABLE).Cells(Row, SrcColumnIndex)
Else
proStr = "{"
For j = 1 To UBound(arr)
SrcColumnIndex = SrcRowNameToIndex(arr(j))
proStr = proStr & """" & Worksheets(SOURCE_TABLE).Cells(1, SrcColumnIndex) & """" & ":" & Worksheets(SOURCE_TABLE).Cells(Row, SrcColumnIndex)
If j < UBound(arr) Then
proStr = proStr & ", "
End If
Next
proStr = proStr & "}"
Worksheets(TARGET_TABLE).Cells(Row, i) = proStr
End If
Next
Next
End Sub
' 根据传入参数索引单元格,然后返回它后面单元格的值
Function GetValueByKey(ByVal Sheetname As String, Key As String, ByVal RowLimit As Integer, ByVal SearchColumn As Integer) As String
For Row = 1 To RowLimit
If Worksheets(Sheetname).Cells(Row, SearchColumn) = Key Then
GetValueByKey = Worksheets(Sheetname).Cells(Row, SearchColumn + 1)
End If
Next Row
End Function
' 计算行数,从第一行开始往下数,直到第N行第1列为空,则行数为N-1
Function CountRow(ByVal Sheetname As String) As Integer
Count = 1
CountRow = 1
While Count > 0
If Worksheets(Sheetname).Cells(Count, 1) <> "" Then
CountRow = Count
Count = Count + 1
Else
Count = 0
End If
Wend
End Function
' 计算某行的列数
Function CountColumn(ByVal Sheetname As String, ByVal Row As Integer) As Integer
Count = 1
CountColumn = 1
While Count > 0
If Worksheets(Sheetname).Cells(Row, Count) <> "" Then
CountColumn = Count
Count = Count + 1
Else
Count = 0
End If
Wend
End Function
' 字母列号转数字
Function ColumnNumber(ByVal ColumnLetter As String) As Integer
If Len(ColumnLetter) > 1 Then
ColumnNumber = (Asc(Mid(ColumnLetter, 1, 1)) - 64) * 26 + (Asc(Mid(ColumnLetter, 2, 1)) - 64)
Else
ColumnNumber = Asc(ColumnLetter) - 64
End If
End Function
这个是控制页面
上面Ctrl表的配置表示:
把策划表Source里面的mechaId列的数据复制到程序表的mechaId列;
把策划表Source里面的quality列的数据复制到程序表的quality列;
把策划表的
hp |
wuliattack |
wulidefend |
nengliangattack |
nengliangdefend |
critRate |
antiCritRate |
hitRate |
missRate |
gedangdj |
pojidj |
recoverEnergy |
attackSpeed |
critHarmRate |
damageleixin |
这些列采用JSON合并复制到程序表的properties列。
这个是策划的数据表
这个是程序的数据表(通过点击控制页的按钮生成的)
写这个包括查VBA的资料总共大概花了2个小时,不得不说,VBA的语法真不好看!
分享到:
相关推荐
采用VBA开发增强了EXCEL2010数据保护,数据筛选,数据整理等5个功能菜单,是本人实际工作中常用功能,代码采用密码保护,但不妨碍使用。压缩包含EXCEL.XLMS和使用说明两个文件,由于不能将说明书全部放在这里,只好...
本人上传的一个使用工具“VBA数据整工具”由于受字数限制没法说清,特在此上传同名的使用说明一份,如有需要可在CSDN查找同名的对应资料使用。
一个基于VBA的数据字典生成宏 使用word的宏生成数据字典word文档
基于VBA的EXCEL数据簿和SQL数据库转换处理方法.pdf
基于Excel VBA的批量数据提取工具开发 基于Excel VBA的批量数据提取工具开发
VBA 工具增强工具用于辅助开发VBA
VBA代码的工具,可以自动添加函数头,模块头,以及添加行号(针对一个过程或者函数体)
采用Microsoft Basic 6.0 编程工具,利用VBA语言通过宏录制技术和嵌入控件及对象技术将Excel应用程序中的数据自动生成图表,并实现Excel工作簿和Word文档两个应用程序之间的数据无缝连接,进而通过Word文档的书签...
VBA+SQLServer跨电脑读写数据传输
VBA 批量数据类型转换,简化办公,大大提高效率。包涵源代码
基于VBA的ARCOBJECTS编程源码
此工具是VBA开发,有录入绑定数据功能,可根据不同需求变更设置,扫描绑定数据自动录入Excel,可用于不同环境,工厂记录关联数据等
基于VBA的CAD二次开发 用于绘制等高线 数字成图等
VBA常用工具箱.xlam
VBA记录更改之前的值,判断是否执行其他VBA操作等,源码在Sheet1
破解EXCEL VBA密码的工具
VBA工程密码破解工具亲测有效,放心下载!
在基于Excel VBA测绘数据处理的相关论文中,一般都涉及到了角度转换问题,但通过验证发现,有些因其算法缺陷,对个别输入值将不能得到正确结果,其原因是在算法中没有充分考虑到计算机运算的精度问题。基于此,作者通过...
基于VBA实现Web数据库平台的自动化数据采集工具的开发.pdf
VBA代码排版工具,可以帮助大家在编程时整理代码格式