要加工加密过的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