基于Excel单元格（A2）值拆分数据行的VBA代码实现咨询

Hey there, let's build out the VBA code you need to split rows based on the number of names in each row's column A cell. The logic we'll implement:

• If a row's column A has 2 names, split it into 2 separate rows, keep all other column values the same, and divide the hour count by 2.
• If column A has 3 names, split into 3 rows, duplicate other columns, and divide hours by 3.

Step-by-Step Setup #

1. Open your Excel file, then press Alt + F11 to launch the VBA Editor.
2. In the Project Explorer pane on the left, right-click your workbook > Insert > Module.
3. Paste the code below into the blank module.
4. Adjust the worksheet name and hour column (details below) to match your file, then press F5 to run the macro.

The VBA Code #

Sub SplitRowsByNames()
    Dim targetSheet As Worksheet
    Dim lastRow As Long, currentRow As Long, nameCount As Integer
    Dim nameList As Variant
    Dim hourColumn As Integer ' Replace with your hours column number (e.g., 4 for column D)
    
    ' Configure these to match your workbook
    Set targetSheet = ThisWorkbook.Worksheets("YourSheetName") ' Swap "YourSheetName" with your actual sheet
    hourColumn = 5 ' Change this to the column holding your hour values
    
    ' Start from the bottom row and move up to avoid missing rows after inserting new ones
    lastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
    
    ' Loop from last row to row 2 (assuming row 1 is headers)
    For currentRow = lastRow To 2 Step -1
        ' Split names using comma + space as delimiter — adjust if your separator is different
        nameList = Split(targetSheet.Cells(currentRow, "A").Value, ", ")
        nameCount = UBound(nameList) + 1
        
        ' Only process rows with 2 or 3 names
        If nameCount = 2 Or nameCount = 3 Then
            ' Insert the required number of blank rows below the current row
            targetSheet.Rows(currentRow + 1 & ":" & currentRow + nameCount - 1).Insert Shift:=xlDown
            
            ' Copy all data from the original row to the new rows
            targetSheet.Rows(currentRow).Copy Destination:=targetSheet.Rows(currentRow + 1 & ":" & currentRow + nameCount - 1)
            
            ' Update each new row with individual names and adjusted hours
            For index = 0 To nameCount - 1
                targetSheet.Cells(currentRow + index, "A").Value = nameList(index)
                targetSheet.Cells(currentRow + index, hourColumn).Value = targetSheet.Cells(currentRow, hourColumn).Value / nameCount
            Next index
        End If
    Next currentRow
    
    MsgBox "Row split finished! Check your sheet for the updated data.", vbInformation
End Sub

Key Adjustments You Need to Make #

• Worksheet Name: Replace "YourSheetName" with the actual name of your worksheet (e.g., "Data").
• Hour Column: Change hourColumn = 5 to the column number where your hour values are stored. For example, if hours are in column C, use 3; column D would be 4.
• Name Separator: If your names are separated by something other than ", " (like a semicolon "; " or just a space), update the delimiter in the Split function to match.
• Header Row: The code assumes your header is in row 1. If your data starts at a different row (e.g., row 3), change the For currentRow = lastRow To 2 Step -1 line to use your starting row number instead of 2.

Pro Tip #

Always test this macro on a copy of your workbook first! This way you can verify the output is exactly what you want without risking your original data.

内容的提问来源于stack exchange，提问作者Sanjeev kumar