- 另一种拆分，按照指定列的内容将一行拆分成多行|完整代码
1、在工作表“vba前”里，命令按钮点击事件，调用拆分过程： Private Sub CmdSplit_Click() Call mySplitEnd Sub 2、在myModule里，mySplit过程，拆分数据： Sub mySplit() Dim ws As Worksheet, iRow As Integer, iCol As Integer Dim rng As Range, arr() Dim temp(), str() As String Dim arrWeight() Set ws = Sheet1 arr = ws.UsedRange iRow = UBound(arr) iCol = UBound(arr, 2) ReDim temp(1 To iCol, 1 To 1) '//填充表头 For i = 1 To iCol temp(i, 1) = arr(1, i) Next For i = 2 To iRow If arr(i, 3) <> "" Then str = Split(arr(i, 3), "/") k = UBound(temp, 2) For j = 0 To UBound(str) arrWeight = getWeight(str(j), CStr(arr(i, 13))) ReDim Preserve temp(1 To iRow, 1 To k + j + 1) For s = 1 To iCol If s = 3 Then '//发货工厂 temp(s, UBound(temp, 2)) = str(j) ElseIf s = 5 Then '//订单号码 temp(s, UBound(temp, 2)) = arrWeight(2) ElseIf s = 6 Then '//吨位数 temp(s, UBound(temp, 2)) = arrWeight(1) Else '//其他字段，取原表数据 temp(s, UBound(temp, 2)) = arr(i, s) End If Next Next End If Next Set ws = Sheet3 ws.UsedRange.Clear Set rng = ws.Cells(1, 1).Resize(UBound(temp, 2), UBound(temp)) With rng .Value2 = Application.WorksheetFunction.Transpose(temp) .Borders.LineStyle = 1 End With MsgBox "Done!" ws.ActivateEnd Sub 3、在myModule里，自定义函数getWeight，取得吨位数、订单号码： Function getWeight(factory As String, scheduleNo As String) As Variant Dim ws As Worksheet Dim arr(), temp() Set ws = Sheet2 arr = ws.UsedRange ReDim temp(1 To 2) For i = 2 To UBound(arr) If arr(i, 2) = factory And arr(i, 1) = scheduleNo Then temp(1) = temp(1) + arr(i, 3) temp(2) = arr(i, 4) End If Next getWeight = tempEnd Function
|
