記錄一次幫策劃寫的基於VBA的數據轉化工具

由於策劃計算的表格結構和程序實際使用的數據表結構不一定一致，因此有時候經常需要做數據轉化。把策劃自己的表格轉成程序需要的格式，然後再導入數據庫。這次也是策劃有個表，裏面有多個字段分別表示多個屬性，但是程序考慮到通用，不想一個屬性增加一個字段，因此想用一個字段，然後採用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的語法真不好看！