Excel, VBA teilt einen Zellenwert in mehrere Zeilen auf

Question

Ich versuche, einige Informationen in Excel zu automatisieren.

Ich muss den Wert in Spalte A gleichmäßig durch die Nummer der „Geschäftsbereiche“ (Spalte E) teilen und jeden „Geschäftsbereich“ in einer separaten Zeile anzeigen.

Ist das möglich und wie geht das?

---

Eingang:

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

Erwartetes Ergebnis:

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

Vorausgesetzt, alle Jobs in „Line of Business“ enden mit einem Doppelpunkt, ist dies mit dem folgenden Code möglich:

Denken Sie daran, dass die Aktion nicht rückgängig gemacht werden kann. Erstellen Sie also zunächst eine Sicherungskopie.

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

Und daraus erhalten Sie:

Hierzu:

Ich habe die ausgeschnittenen Daten absichtlich auf dasselbe Blatt gelegt, damit Sie sie überprüfen können, bevor Sie sie kopieren und einfügen.

Wie füge ich VBA in MS Office hinzu?