VBA操作加密excel

      要加工加密过的excel文件，由于不是技术部的人用，又是小功能，不能去专门写个后台管理，也不好用poi单独写个main方法跑（没环境）。

       就花了一两天时间边研究边写VBA。涉及到操作的excel就不做详细讲解了（可能会有公司信息）。可以看看语法、逻辑处理之类的。还有下面步骤中涉及到的PERSONAL.XLSB、hello.bass文件，这里不提供，后面会有hello.bass的代码。可以直接保存。

       下面详细讲解下如何开发及用vba

1、设置开发工具

在左侧找到开发工具，添加到右侧。确定

在开发工具里点击宏安全性

选择启用所有宏

2、检查C:\Users\用户\AppData\Roaming\Microsoft\Excel\XLSTART是否存在PERSONAL.XLSB文件

2.1、如没有，则直接把PERSONAL.XLSB文件拷贝到此目录下

2.2、如有，则先随便打开一个excel，alt+F11

2.3、选择VBAProject(PERSONAL.XLSB),右键，选择导入文件

2.4、选择要导入的.bas文件

3、在菜单栏空白处右键，选择自定义功能区

4、选择你要保持按钮的区域，我这里以开始菜单栏为列。选择开始，点击新建组。

5、选择重命名

6、选择要显示的按钮，输入名称

7、选择宏

8、左侧选择PERSONAL.XLSB!hello，右侧选择hello。点击添加。

9、重命名,可自定义名字

10、点击确定，在开始栏即可看到按钮。

11、在同目录下建立data.xlsx（需要导入到的文件）,并打开data.xlsx，再点击按钮。

 

hello.bass 文件 代码如下

Sub hello()


    Set Sh1 = ActiveSheet

    Set Sh2 = Workbooks("data.xlsx").Sheets(1)

    Dim dataMap As Object
    Set dataMap = CreateObject("Scripting.Dictionary")
    Set rowMap = CreateObject("Scripting.Dictionary")
    
    For i = 1 To 30
            For j = 1 To 31
        
             'Debug.Print "i=" & i & "j=" & j & Sh1.Cells(i, j)
        Next
    Next
    
    For i = 11 To 290

            For j = 14 To 31

              Dim r0 As Integer        '行号
              Dim c0 As Integer        '列号
              r0 = i
              c0 = j

              If j = 16 Then
                 If dataMap.Exists(Sh1.Cells(r0, c0 - 1).Value & Sh1.Cells(r0, c0).Value) Then
                    dataMap(Sh1.Cells(r0, c0 - 1).Value & Sh1.Cells(r0, c0).Value) = 2
                    Else
                    dataMap.Add (Sh1.Cells(r0, c0 - 1).Value & Sh1.Cells(r0, c0).Value), 1
                   End If

              End If
            Next
        Next
    
    
'    For Each F In dataMap
'        Debug.Print F
'        Debug.Print dataMap(F)
'    Next
    
    
    Dim ni As Integer
    Dim r As Integer        '行号
    Dim nr As Integer       '新行
    Dim kr As Integer       '多规格行
    ni = 0
    Dim itype As Integer
     
     For i = 11 To 290
     
     
      
     r = i
     nr = r - 8
     
     
       If dataMap(Sh1.Cells(i, 15).Value & Sh1.Cells(i, 16).Value) = 1 Then '单规格
        itype = 1
        'Debug.Print Sh1.Cells(i, 15).Value & Sh1.Cells(i, 16).Value & "单规格"
        Else '多规格
        itype = 2
        'Debug.Print Sh1.Cells(i, 15).Value & Sh1.Cells(i, 16).Value & "多规格"
       End If
     
      If itype = 2 Then
        If rowMap.Exists(Sh1.Cells(i, 15).Value & Sh1.Cells(i, 16).Value) Then
           
        Else
            If rowMap.Exists(Sh1.Cells(i - 1, 15).Value & Sh1.Cells(i - 1, 16).Value) Then
                rowMap.RemoveAll
             End If
            kr = r - 8 + ni
            'Debug.Print kr
            
            ni = ni + 1
            rowMap.Add Sh1.Cells(i, 15).Value & Sh1.Cells(i, 16).Value, 1
        End If
      End If
        nr = nr + ni
        'Sh2.Cells(i - 8, 1).Value = Cells(30, 7)   '商品名称
        'Sh2.Cells(i - 8, 3).Value = Cells(29, 2)    '公司code
        Sh2.Cells(nr, 4).Value = Cells(29, 3)    '公司名称
        Sh2.Cells(nr, 13).Value = Cells(27, 4)   '材料大类
        Sh2.Cells(nr, 14).Value = Cells(27, 6)   '材料类别
        Sh2.Cells(nr, 15).Value = Cells(30, 7)   '产品类别
             
                
            For j = 14 To 31

                     
              Dim c As Integer        '列号

              c = j
              
             
              If j = 15 Then
              Sh2.Cells(nr, 1).Value = Sh1.Cells(r, c).Value & " " & Sh1.Cells(30, 7).Value     '商品名称
              Sh2.Cells(nr, 2).Value = Sh1.Cells(r, c).Value  '品牌
              End If
              If j = 16 Then
                If InStr(Sh1.Cells(r, c + 1).Value, "Φ") > 0 Then
                    If (InStr(Sh1.Cells(r, c + 1).Value, "（") > 0 And InStr(Sh1.Cells(r, c + 1).Value, "Φ") > InStr(Sh1.Cells(r, c + 1).Value, "（")) Then
                        Sh2.Cells(nr, 5).Value = Sh1.Cells(r, c).Value & " " & Sh1.Cells(r, c + 1).Value '商品型号
                    Else
                         Sh2.Cells(nr, 5).Value = Sh1.Cells(r, c).Value & " " & Split(Sh1.Cells(r, c + 1).Value, "Φ")(0) '商品型号
                    End If
                Else
                    Sh2.Cells(nr, 5).Value = Sh1.Cells(r, c).Value '商品型号
                End If
              End If
              If j = 17 Then
               If InStr(Sh1.Cells(r, c).Value, "Φ") > 0 Then
                    If InStr(Sh1.Cells(r, c).Value, "Φ") > InStr(Sh1.Cells(r, c).Value, "（") Then
                        If itype = 1 Then
                            Sh2.Cells(nr, 6).Value = "单规格商品" ''商品规格
                        Else
                           Sh2.Cells(nr, 6).Value = Right(Sh1.Cells(r, c).Value, Len(Sh1.Cells(r, c).Value) - Len(Split(Sh1.Cells(r, c).Value, "Φ")(0)) - 1) '商品规格
                        End If
                        
                    Else
                         Sh2.Cells(nr, 6).Value = Right(Sh1.Cells(r, c).Value, Len(Sh1.Cells(r, c).Value) - Len(Split(Sh1.Cells(r, c).Value, "Φ")(0)) - 1)  '商品规格
                    End If
                Else
                     Sh2.Cells(nr, 6).Value = Sh1.Cells(r, c).Value  '商品规格
                End If
              End If
              If j = 19 Then
              Sh2.Cells(nr, 8).Value = Sh1.Cells(r, c).Value   '市场价
              End If
              If j = 18 Then
              Sh2.Cells(nr, 11).Value = Sh1.Cells(r, c).Value  '计量单位
              End If
              If nr = kr + 1 Then
            Debug.Print "kr=" & kr
            Sh2.Cells(kr, 4).Value = Sh2.Cells(nr, 4).Value    '公司名称
            Sh2.Cells(kr, 13).Value = Sh2.Cells(nr, 13).Value   '材料大类
            Sh2.Cells(kr, 14).Value = Sh2.Cells(nr, 14)   '材料类别
            Sh2.Cells(kr, 15).Value = Sh2.Cells(nr, 15)  '产品类别
            Sh2.Cells(kr, 1).Value = Sh2.Cells(nr, 1).Value
            Sh2.Cells(kr, 2).Value = Sh2.Cells(nr, 2).Value
            Sh2.Cells(kr, 5).Value = Sh2.Cells(nr, 5).Value
            Sh2.Cells(kr, 6).Value = "多规格商品"
            Sh2.Cells(kr, 8).Value = Sh2.Cells(nr, 8).Value
            Sh2.Cells(kr, 11).Value = Sh2.Cells(nr, 11).Value
        End If
               Sh2.Cells(nr, 6).VerticalAlignment = xlCenter
               Sh2.Cells(nr, 6).HorizontalAlignment = xlLeft
            Next
        Next
End Sub