VBA实现EXCEL转DBC

利用VBA实现对EXCEL转成DBC文件

EXCEL的格式如下：

 

 

VBA代码：

Sub exceltodbc()

    Dim i, j As Integer
    Dim row As Integer
    Dim filepath, GenMsgCycleTime, CM, VAL As String
    Dim MsgName, MsgId, MsgCycle, SignalName, ByteOrder, StartBit, BitPosition, BitLength, Resolution, Offset, SignalMin, SignalMax, Unit, Note As Integer
    Dim itemp As Integer
    Dim stemp As String
    Dim id As Variant
    Dim id_name As String
    Dim str5, str4, str1, str2, str3, str6, str7 As Variant
    Dim state As String
    Dim order As Integer
    Dim englishStr, chinaStr As String
    Dim errorStr As String
    Dim errorColumn As Integer
    Dim strStartBit, strMinValue, strMaxValue, strBitLength As String
    Dim aarow, startRow As Integer
    Dim isture As Boolean

    MsgName = 0         '报文名称
    MsgId = 0           '报文标识符
    MsgCycle = 0        '报文周期时间
    EnglishName = 0     '英文信号名称
    SignalName = 0      '信号名称
    ByteOrder = 0       '排列格式
    StartBit = 0        '起始位
    BitPosition = 0     '信号位置
    BitLength = 0       '信号长度
    Resolution = 0      '精度
    Offset = 0          '偏移量
    SignalMin = 0       '物理最小值
    SignalMax = 0       '物理最大值
    Unit = 0            '单位
    Note = 0            '信号值描述
    
    '1,3,5,0,7,8,10,12,14,15,23,24
    
    '1,4,6,8,9,100,11,12,14,15,21,22
    
    '1,3,5,7,8,9,11,13,15,16,24,25
    
    Application.ReferenceStyle = xlR1C1    '列号显示为数字
       
    For aarow = 1 To 2
        isture = False
        For i = 1 To 30
            If LCase(Cells(aarow, i)) Like "*msg[ _]name*" And MsgName = 0 Then
                MsgName = i
                isture = True
            ElseIf LCase(Cells(aarow, i)) Like "*msg[ _]id*" And MsgId = 0 Then
                MsgId = i
                isture = True
            ElseIf LCase(Cells(aarow, i)) Like "*msg[ _]cycle*" And MsgCycle = 0 Then
                MsgCycle = i
                isture = True
            ElseIf LCase(Cells(aarow, i)) Like "*signal[ _]name*" And EnglishName = 0 Then
                EnglishName = i
                isture = True
            ElseIf LCase(Cells(aarow, i)) Like "*signal[ _]description*" And SignalName = 0 Then
                SignalName = i
                isture = True
            ElseIf LCase(Cells(aarow, i)) Like "*byte[ _]order*" And ByteOrder = 0 Then
                ByteOrder = i
                isture = True
            ElseIf LCase(Cells(aarow, i)) Like "*start[ _]bit*" And StartBit = 0 Then
                StartBit = i
                isture = True
             ElseIf LCase(Cells(aarow, i)) Like "*bit[ _]position*" And BitPosition = 0 Then
                BitPosition = i
                isture = True
            ElseIf LCase(Cells(aarow, i)) Like "*bit[ _]length*" And BitLength = 0 Then
                BitLength = i
                isture = True
            ElseIf LCase(Cells(aarow, i)) Like "*resolution*" And Resolution = 0 Then
                Resolution = i
                isture = True
            ElseIf LCase(Cells(aarow, i)) Like "*offset*" And Offset = 0 Then
                Offset = i
                isture = True
            ElseIf LCase(Cells(aarow, i)) Like "*signal[ _]min*" And LCase(Cells(aarow, i)) Like "*phy*" And SignalMin = 0 Then
                SignalMin = i
                isture = True
            ElseIf LCase(Cells(aarow, i)) Like "*signal[ _]max*" And LCase(Cells(aarow, i)) Like "*phy*" And SignalMax = 0 Then
                SignalMax = i
                isture = True
            ElseIf LCase(Cells(aarow, i)) Like "*unit*" And Unit = 0 Then
                Unit = i
                isture = True
            ElseIf LCase(Cells(aarow, i)) Like "*signal[ _]value[ _]description*" And Note = 0 Then
                Note = i
                isture = True
            End If
        Next
        
        If isture Then
            startRow = aarow + 1
        End If
    Next
    
    
    
    If ByteOrder = 0 Then
        ByteOrder = 99
    End If
    
    If StartBit > 0 Or BitPosition = 0 Then
    
    str4 = InputBox("报文名称 = " & CStr(MsgName) & Chr(10) & _
                    "报文标识符 = " & CStr(MsgId) & Chr(10) & _
                    "报文周期时间 = " & CStr(MsgCycle) & Chr(10) & _
                    "信号名称(英文) = " & CStr(EnglishName) & Chr(10) & _
                    "信号描述(中文) = " & CStr(SignalName) & Chr(10) & _
                    "排列格式 = " & CStr(ByteOrder) & "  如果没有 99：intel 100：moto" & Chr(10) & _
                    "起始位 = " & CStr(StartBit) & Chr(10) & _
                    "信号长度 = " & CStr(BitLength) & Chr(10) & _
                    "精度 = " & CStr(Resolution) & Chr(10) & _
                    "偏移量 = " & CStr(Offset) & Chr(10) & _
                    "物理最小值 = " & CStr(SignalMin) & Chr(10) & _
                    "物理最大值 = " & CStr(SignalMax) & Chr(10) & _
                    "单位 = " & CStr(Unit) & Chr(10) & _
                    "信号值描述 = " & CStr(Note) & Chr(10) & "注：如果没找到这列 ＝ 0", "输入各参数所在的列号", CStr(MsgName) & "," & _
                                                                    CStr(MsgId) & "," & _
                                                                    CStr(MsgCycle) & "," & _
                                                                    CStr(EnglishName) & "," & _
                                                                    CStr(SignalName) & "," & _
                                                                    CStr(ByteOrder) & "," & _
                                                                    CStr(StartBit) & "," & _
                                                                    CStr(BitLength) & "," & _
                                                                    CStr(Resolution) & "," & _
                                                                    CStr(Offset) & "," & _
                                                                    CStr(SignalMin) & "," & CStr(SignalMax) & "," & CStr(Unit) & "," & _
                                                                    CStr(Note))
    Else
     str4 = InputBox("报文名称 = " & CStr(MsgName) & Chr(10) & _
                    "报文标识符 = " & CStr(MsgId) & Chr(10) & _
                    "报文周期时间 = " & CStr(MsgCycle) & Chr(10) & _
                    "信号名称(英文) = " & CStr(EnglishName) & Chr(10) & _
                    "信号描述(中文) = " & CStr(SignalName) & Chr(10) & _
                    "排列格式 = " & CStr(ByteOrder) & "  如果没有 99：intel 100：moto" & Chr(10) & _
                    "信号位置 = " & CStr(BitPosition) & Chr(10) & _
                    "信号长度 = " & CStr(BitLength) & Chr(10) & _
                    "精度 = " & CStr(Resolution) & Chr(10) & _
                    "偏移量 = " & CStr(Offset) & Chr(10) & _
                    "物理最小值 = " & CStr(SignalMin) & Chr(10) & _
                    "物理最大值 = " & CStr(SignalMax) & Chr(10) & _
                    "单位 = " & CStr(Unit) & Chr(10) & _
                    "信号值描述 = " & CStr(Note) & Chr(10) & "注：如果没找到这列 ＝ 0", "输入各参数所在的列号", CStr(MsgName) & "," & _
                                                                    CStr(MsgId) & "," & _
                                                                    CStr(MsgCycle) & "," & _
                                                                    CStr(EnglishName) & "," & _
                                                                    CStr(SignalName) & "," & _
                                                                    CStr(ByteOrder) & "," & _
                                                                    CStr(BitPosition) & "," & _
                                                                    CStr(BitLength) & "," & _
                                                                    CStr(Resolution) & "," & _
                                                                    CStr(Offset) & "," & _
                                                                    CStr(SignalMin) & "," & CStr(SignalMax) & "," & CStr(Unit) & "," & _
                                                                    CStr(Note))
    
    End If
                    
    If str4 = "" Then
        Exit Sub
    End If
                   
    str5 = Split(str4, ",")
    
    If UBound(str5) = 13 Then
        MsgName = Int(str5(0))         '报文名称
        MsgId = Int(str5(1))           '报文标识符
        MsgCycle = Int(str5(2))       '报文周期时间
        EnglishName = Int(str5(3))     '英文信号名称
        SignalName = Int(str5(4))      '信号名称
        ByteOrder = Int(str5(5))       '排列格式
        
        If StartBit > 0 Or BitPosition = 0 Then
            StartBit = Int(str5(6))       '起始位
        Else
            BitPosition = Int(str5(6))       '信号位置
        End If
        
        BitLength = Int(str5(7))      '信号长度
        Resolution = Int(str5(8))     '精度
        Offset = Int(str5(9))         '偏移量
        SignalMin = Int(str5(10))       '物理最小值
        SignalMax = Int(str5(11))       '物理最大值
        Unit = Int(str5(12))           '单位
        Note = Int(str5(13))           '信号值描述
       
        
        If MsgName <> 0 Then
            Cells(1, MsgName) = "Msg Name" & Chr(10) & "报文名称"
        End If
        If MsgId <> 0 Then
            Cells(1, MsgId) = "Msg ID" & Chr(10) & "报文标识符"
        End If
        If MsgCycle <> 0 Then
            Cells(1, MsgCycle) = "Msg Cycle Time(ms)" & Chr(10) & "报文周期时间"
        End If
        If EnglishName <> 0 Then
            Cells(1, EnglishName) = "Signal Name" & Chr(10) & "信号名称"
        End If
        If SignalName <> 0 Then
            Cells(1, SignalName) = "Signal Description" & Chr(10) & "信号描述"
        End If
        If ByteOrder <> 0 Then
            Cells(1, ByteOrder) = "Byte Order" & Chr(10) & "排列格式"
        End If
        If StartBit <> 0 Then
            Cells(1, StartBit) = "Start Bit" & Chr(10) & "起始位"
        End If
        If BitPosition <> 0 Then
            Cells(1, BitPosition) = "Bit Position" & Chr(10) & "信号位置"
        End If
        If BitLength <> 0 Then
            Cells(1, BitLength) = "Bit Length(bit)" & Chr(10) & "信号长度"
        End If
        If Resolution <> 0 Then
            Cells(1, Resolution) = "Resolution" & Chr(10) & "精度"
        End If
        If Offset <> 0 Then
            Cells(1, Offset) = "Offset" & Chr(10) & "偏移量"
        End If
        If SignalMin <> 0 Then
            Cells(1, SignalMin) = "Signal Min. Value(phys)" & Chr(10) & "物理最小值"
        End If
        If SignalMax <> 0 Then
            Cells(1, SignalMax) = "Signal Max. Value(phys)" & Chr(10) & "物理最大值"
        End If
        If Unit <> 0 Then
            Cells(1, Unit) = "Unit" & Chr(10) & "单位"
        End If
        If Note <> 0 Then
            Cells(1, Note) = "Signal Value Description" & Chr(10) & "信号值描述"
        End If
        
    End If
    
    
    
    row = ActiveSheet.UsedRange.Rows.Count + 1
    
    filepath = Application.ActiveWorkbook.Path & "\" & Replace(Application.ActiveWorkbook.Name, "?", "") & ".dbc"
    
    Open filepath For Output As #1
    Print #1, "VERSION """""
    Print #1, "NS_:"
    Print #1, "BS_:"
    Print #1, "BU_: "
    
    On Error GoTo errorpross
    
    For i = startRow To row
        If EnglishName > 0 Then
            If Trim(Cells(i, EnglishName)) <> "" Then
                englishStr = Replace(Replace(Replace(Replace(Trim(Cells(i, EnglishName)), " ", "_"), Chr(13), ""), Chr(10), ""), "&", "_")
            Else
                englishStr = ""
            End If
        Else
           englishStr = ""
        End If
        
        If SignalName > 0 Then
            If Trim(Cells(i, SignalName)) <> "" Then
                chinaStr = Replace(Replace(Replace(Replace(Trim(Cells(i, SignalName)), " ", " "), Chr(13), ""), Chr(10), ""), "&", "_")
            Else
                chinaStr = ""
            End If
        Else
           chinaStr = ""
        End If
     
        If Trim(Cells(i, MsgId)) <> "" And UCase(Trim(Cells(i, MsgId))) Like "0X*" Then
        
            'BO_ 528 VCU_0x210: 8 VCU
            errorStr = "ID 转成10进制有误"
            errorColumn = MsgId
            stemp = Trim(Replace(UCase(Cells(i, MsgId)), "0X", ""))
             If stemp Like "*[0-9,a-f,A-F]*" Then
                id = Application.WorksheetFunction.Hex2Dec(stemp)
                If id > 2047 Then
                    id = id + 2147483648#
                End If
                
            Else
                MsgBox ("没有读取到CAN ID值")
                Exit Sub
            End If
            
            str1 = Split(Cells(i, MsgName), "_")
        
            Print #1, "BO_ " & CStr(id) & " " & Replace(Cells(i, MsgName), "&", "_") & ": 8 " & str1(0)
             
            'BA_ "GenMsgCycleTime" BO_ 2550588827 200;
            If Cells(i, MsgCycle) <> "" Then
                GenMsgCycleTime = GenMsgCycleTime & "BA_ ""GenMsgCycleTime"" BO_ " & CStr(id) & " " & Cells(i, MsgCycle) & ";" & Chr(10)
            End If
            
        ElseIf chinaStr <> "" Or englishStr <> "" Then
            'SG_ BMS_Value_0 : 7|16@0+ (0.1,0) [0|6553.5] "V" Vector__XXX
            
            If ByteOrder = 99 Then
                 order = 1
            ElseIf ByteOrder = 100 Then
                order = 0
            ElseIf UCase((Cells(i, ByteOrder))) = "" Then
                '不写
            ElseIf UCase((Cells(i, ByteOrder))) = "INTEL" Then
                order = 1
            Else
                order = 0
            End If
            
            If englishStr <> "" Then
                id_name = englishStr
            Else
                id_name = str1(0) & "_V_" & CStr(i)
            End If
            
            If StartBit > 0 Then
                strStartBit = Trim(Cells(i, StartBit))
            ElseIf BitPosition > 0 Then
                errorStr = "没有找到信号位置"
                errorColumn = BitPosition
                
                str6 = Trim(Cells(i, BitPosition))
                str7 = Split(str6, Chr(10))
                str6 = Split(str7(0), "-")
                If UBound(str6) = 0 Then
                    strStartBit = str6(0)
                Else
                    strStartBit = str6(1)
                End If
            Else
               errorStr = "没有找到启始位"
               errorColumn = BitLength
                GoTo errorpross
            End If
            
            If SignalMin > 0 Then
                strMinValue = Trim(Cells(i, SignalMin).Text)
            Else
                strMinValue = 0
            End If
            
            If SignalMax > 0 Then
                strMaxValue = Replace(Trim(Cells(i, SignalMax).Text), ",", "")
            Else
                strMaxValue = 1
            End If
            
            If BitLength > 0 Then
                strBitLength = Trim(Cells(i, BitLength))
            Else
                errorStr = "没有找到长度"
                errorColumn = BitLength
                GoTo errorpross
            End If
            
            Print #1, " SG_ " & id_name & " : " & strStartBit & "|" & strBitLength & "@"; CStr(order) & "+ (" & Trim(Cells(i, Resolution).Text) & "," & Trim(Cells(i, Offset)) & ") [" & strMinValue & "|" & strMaxValue & "] """ & Cells(i, Unit) & """ Vector__XXX"
        
            'CM_ SG_ 2550588827 BMS_Value_0 "充电电压";
            
            If chinaStr <> "" Then
                CM = CM & "CM_ SG_ " & CStr(id) & " " & id_name & " """ & chinaStr & """;" & Chr(10)
            End If
            'VAL_ 2550591717 OBC_State_8 0 "正在充电" 1 "停止充电" ;
                        
            If Trim(Cells(i, Note)) <> "" And Trim(Cells(i, Resolution)) = 1 And Trim(Cells(i, Offset)) = 0 And (Trim(Cells(i, Unit)) = "" Or Trim(Cells(i, Unit)) = "bit") Then
            
                state = ""
                    
                str3 = Split(Cells(i, Note), Chr(10))
                
                For j = 0 To UBound(str3)
                    str2 = Split(Replace(str3(j), "：", ":"), ":")
                    If UBound(str2) = 1 Then
                        If str2(0) Like "*~*" Or str2(0) Like "*-*" Or LCase(str2(0)) Like "*other*" Then
                            'asd
                        ElseIf LCase(str2(0)) Like "*bit*" Then
                            Cells(i, Note).Interior.ColorIndex = 3
                            Cells(i, Note).Select
                            MsgBox ("生成异常" & Chr(10) & "错误：状态值有误" & Chr(10) & "异常行数：" & CStr(i))
                            Exit For
                        Else
                            errorStr = "状态值 转成10进制有误"
                            errorColumn = Note
                            stemp = Trim(Replace(LCase(Trim(str2(0))), "0x", ""))
                            If stemp Like "*[0-9,a-f,A-F]*" Then
                                state = state & " " & Application.WorksheetFunction.Hex2Dec(stemp) & " """ & Replace(Trim(str2(1)), """", "") & """"
                            End If
                        End If
                    End If
                Next
                
                If state <> "" Then
                    VAL = VAL & "VAL_ " & CStr(id) & " " & id_name & state & ";" & Chr(10)
                End If
             
            End If
            
        End If
    
    Next
    
    Print #1, CM
    
    Print #1, "BA_DEF_ BO_ ""GenMsgCycleTime"" INT 0 0;"
    Print #1, "BA_DEF_DEF_ ""GenMsgCycleTime"" 0;"
    Print #1, GenMsgCycleTime
    Print #1, VAL
    
    Close #1
    
    MsgBox ("DBC文件生成完成！" & Chr(10) & "路径：" & filepath)
 
    Exit Sub
    
errorpross:
    Cells(i, errorColumn).Interior.ColorIndex = 3
    Cells(i, errorColumn).Select
    
    Close #1
    
    MsgBox ("生成异常" & Chr(10) & "错误：" & errorStr & Chr(10) & "异常行数：" & CStr(i))
    
End Sub

由于生成DBC时认为EXCEL是标准格式，如果在打开DBA时，提示错误，可以用文本文件打开DBC对相应错误行进行修改!