Предполагая, что у вас есть все задания в "Линия бизнеса", заканчивающиеся двоеточием, это возможно с помощью следующего кода:
Помните, что отмены нет, поэтому сначала сделайте резервную копию.
Public Sub SortRecords()
Dim intENDROW As Integer
Dim intCOUNTER As Integer
Dim intCOUNTER2 As Integer
Dim intSTRINGLENGTH As Integer
Dim intNUMBERCOLON As Integer
Dim intSTARTROW As Integer
Dim currDIVIDED As Currency
Dim intSTART As Integer
Dim intPOS As Integer
intENDROW = Range("A65536").End(xlUp).Row 'Get last row containing data
intSTARTROW = intENDROW + 3
' Re-populate headers
Range("A" & intENDROW + 2).Value = Range("A1").Text
Range("B" & intENDROW + 2).Value = Range("B1").Text
Range("C" & intENDROW + 2).Value = Range("C1").Text
Range("D" & intENDROW + 2).Value = Range("D1").Text
Range("E" & intENDROW + 2).Value = Range("E1").Text
For intCOUNTER = 2 To intENDROW
intNUMBERCOLON = 0
intSTART = 1
intSTRINGLENGTH = Len(Range("E" & intCOUNTER).Text) ' Get length of string containing "Line of Business"
For intCOUNTER2 = 1 To intSTRINGLENGTH
If Mid(Range("E" & intCOUNTER).Text, intCOUNTER2, 1) = ";" Then intNUMBERCOLON = intNUMBERCOLON + 1 ' Count how many colons are in this line
Next
If intNUMBERCOLON > 0 Then
currDIVIDED = Range("A" & intCOUNTER).Value / intNUMBERCOLON ' Get average value of Amount column
For intCOUNTER2 = 1 To intNUMBERCOLON
intPOS = InStr(intSTART, Range("E" & intCOUNTER).Text, ";", vbTextCompare) ' Find each instance of a colon
Range("E" & intSTARTROW + intCOUNTER2 - 1).Value = Mid(Range("E" & intCOUNTER).Text, intSTART, intPOS - intSTART + 1) ' Copy text before colon to new line
intSTART = intPOS + 2 ' Update start search position
Next
For intCOUNTER2 = intSTARTROW To (intNUMBERCOLON + intSTARTROW - 1)
Range("A" & intCOUNTER2).Value = currDIVIDED
Range("B" & intCOUNTER2).Value = Range("B" & intCOUNTER).Text
Range("C" & intCOUNTER2).Value = Range("C" & intCOUNTER).Text
Range("D" & intCOUNTER2).Value = Range("D" & intCOUNTER).Text
Next
intSTARTROW = intSTARTROW + intNUMBERCOLON
End If
Next
Range("A1", "A65536").NumberFormat = "General" ' Restore Amount column to a standard number
End Sub
И это даст вам из этого:
К этому:
Я намеренно поместил вырезанные данные на один лист, чтобы вы могли проверить их, прежде чем скопировать и вставить их.
Как добавить VBA в MS Office?