Excel, VBA divide um valor de célula em várias linhas

Question

Estou tentando automatizar algumas informações no Excel.

Preciso que o valor na Coluna A seja dividido igualmente pelo número de “Linha de negócios” (Coluna E) e exiba cada “Linha de negócios” em uma linha separada.

É possível e como fazer?

---

Entrada:

Amount   summary_type   Application         Cost Source   Line of Business
0,6      Employee       eDrive Monitoring   eDrive        R&D; APAC; Group IT;

Resultado esperado:

Amount   summary_type   Application         Cost Source   Line of Business
0,2      Employee       eDrive Monitoring   eDrive        R&D;
0,2      Employee       eDrive Monitoring   eDrive        APAC;
0,2      Employee       eDrive Monitoring   eDrive        Group IT;

Answer 1

Supondo que você tenha todos os empregos em "Linha de negócios" terminando com dois pontos, isso é possível com o seguinte código:

Lembre-se de que não há como desfazer, então faça um backup primeiro.

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

E isso lhe dará a partir disso:

Para isso:

Coloquei deliberadamente os dados de corte na mesma folha para que você possa verificá-los antes de copiá-los e colá-los.

Como adiciono VBA no MS Office?