如何将文本内容通过VBA编程自动转换，请看附件。

xiao-wu1987

求助，如何将文本内容通过VBA编程自动转换，请看附件。

tspliu

录制宏：选择要复制的列，复制，粘贴。然后运行宏。。。

lsc900707

1. Sub gj23w98()
   
2.     ReDim brr(1 To 9999, 1 To 15)
   
3.     arr = [b7].CurrentRegion
   
4.     For i = 1 To UBound(arr)
   
5.         m = m + 1
   
6.         brr(m, 1) = arr(i, 3)
   
7.         For j = 2 To 15
   
8.             brr(m, j) = arr(i, j + 3)
   
9.         Next
   
10.         s = s + Val(brr(m, 7))
    
11.     Next
    
12.     brr(m + 1, 1) = "合计": brr(m + 1, 7) = s
    
13.     With Sheet2
    
14.         If m Then
    
15.             .Cells.Clear
    
16.             .[a1].Resize(m + 1, 15) = brr
    
17.             .[a1].Resize(m + 1, 15).Borders.LineStyle = 1
    
18.         End If
    
19.     End With
    
20. End Sub

复制代码

lsc900707

测试参考附件：

xiao-wu1987

lsc900707 发表于 2019-5-24 12:39
测试参考附件：

你好，转换后规格型号的数据前面一个0没有了

xiao-wu1987

tspliu 发表于 2019-5-24 11:50
录制宏：选择要复制的列，复制，粘贴。然后运行宏。。。

我对宏不太熟，能否直接帮忙编辑一个宏
感谢了

lsc900707

xiao-wu1987 发表于 2019-5-24 13:37
你好，转换后规格型号的数据前面一个0没有了

加一句代码就行了：

xiao-wu1987

lsc900707 发表于 2019-5-24 14:38
加一句代码就行了：

太感谢了

xiao-wu1987

lsc900707 发表于 2019-5-24 12:39
测试参考附件：

你好，我突然发现转换后的排序是根据前面一个表的名称排序的，我需要排序成我B1表格产品名称排序，能都做到啊

lsc900707

代码修改好了：

1. Sub gj23w98()
   
2.     ReDim brr(1 To 9999, 1 To 15)
   
3.     arr = [b7].CurrentRegion
   
4.     For i = 1 To UBound(arr)
   
5.         m = m + 1
   
6.         brr(m, 1) = arr(i, 3)
   
7.         brr(m, 2) = arr(i, 5)
   
8.         brr(m, 3) = arr(i, 8)
   
9.         brr(m, 4) = arr(i, 6)
   
10.         brr(m, 5) = arr(i, 7)
    
11.         For j = 6 To 15
    
12.             brr(m, j) = arr(i, j + 3)
    
13.         Next
    
14.         s = s + Val(brr(m, 7))
    
15.     Next
    
16.     brr(m + 1, 1) = "合计": brr(m + 1, 7) = s
    
17.     With Sheets("B1表")
    
18.         If m Then
    
19.             .Cells.Clear
    
20.             .[a1].Resize(m + 1, 15) = brr
    
21.             .[a1].Resize(m + 1, 15).Borders.LineStyle = 1
    
22.         End If
    
23.     End With
    
24. End Sub

复制代码