excel - 在 Excel 中根据两个或多个条件插入行

Question

每行都有一个 ID 和一系列多种灯（类型）和功率（瓦）

我需要根据以下条件选择值并以特定方式将它们插入到主工作表中：

1. 如果在同一行中有 2 个灯的功率（瓦​​特）和类型相同，则应在另一张表的类型列中插入灯串类型+功率。

2. 如果同一行中存在不同功率（瓦特）或类型的灯，则应在第一行下方插入具有相同 ID 的其他类型的灯。例如：

你们能帮帮我吗？

标签： excelvbamultiple-columnsrows

Answer 1

试试这个代码：

Sub SubTotals()
    
    'Declarations.
    Dim DblResultCounter As Double
    Dim DblCounter01 As Double
    Dim RngStartingCell As Range
    Dim RngFirstData As Range
    Dim RngIDList As Range
    Dim RngID As Range
    Dim RngTarget As Range
    Dim StrResult() As String
    Dim StrWatts As String
    Dim StrType As String
    
    'Creating a new worksheet.
    ActiveSheet.Copy After:=ActiveSheet
    
    'Settings.
    Set RngStartingCell = Range("A1")
    Set RngFirstData = Range("F2")
    StrWatts = "WATTS"
    StrType = "TYPE"
    
    'Setting RngIDList.
    Set RngIDList = Range(RngStartingCell.Offset(1, 0), RngStartingCell.End(xlDown))
    
    'Covering each cell in RngIDList.
    For Each RngID In RngIDList
        
        'Setting RngTarget as the last cell on the right with data.
        Set RngTarget = Cells(RngID.Row, Columns.Count).End(xlToLeft)
        
        'Covering all the columns with data.
        Do Until RngTarget.Column <= RngFirstData.Column
            
            'Searching for the next columns with StrWatts and StrType as headers.
            Do Until Cells(RngStartingCell.Row, RngTarget.Column).Value = StrWatts And _
                     Cells(RngStartingCell.Row, RngTarget.Column - 1).Value = StrType
                Set RngTarget = RngTarget.Offset(0, -1)
            Loop
            
            'Reporting the results.
            DblResultCounter = DblResultCounter + 1
            ReDim Preserve StrResult(1 To 3, 1 To DblResultCounter)
            StrResult(1, DblResultCounter) = RngID.Value
            StrResult(2, DblResultCounter) = RngTarget.Offset(0, -1).Value & RngTarget.Value
            StrResult(3, DblResultCounter) = RngTarget.Offset(0, -2).Value
            
            Set RngTarget = RngTarget.Offset(0, -1)
        Loop
    Next
    
    'Setting RngTarget as the last of the cell in RngIdList.
    Set RngTarget = RngIDList.Cells(RngIDList.Rows.Count, 1)
    
    'Covering the whole list from the bottom up.
    Do Until RngTarget.Row = RngStartingCell.Row
        
        'Covering each value in StrResult().
        For DblCounter01 = 1 To DblResultCounter
            
            'Checking if the IDs match.
            If RngTarget.Value = StrResult(1, DblCounter01) Then
                
                'Reporting the results.
                RngTarget.Offset(1, 0).EntireRow.Insert
                RngTarget.Offset(1, 0).Value = StrResult(1, DblCounter01)
                RngTarget.Offset(1, 1).Value = StrResult(3, DblCounter01)
                RngTarget.Offset(1, 2).Value = StrResult(2, DblCounter01)
                
            End If
        Next
        
        Set RngTarget = RngTarget.Offset(-1, 0)
    Loop
    
    'Sorting the list.
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=RngTarget.EntireColumn, _
                        SortOn:=xlSortOnValues, _
                        Order:=xlAscending, _
                        DataOption:=xlSortNormal
        .SortFields.Add Key:=RngTarget.Offset(0, 2).EntireColumn, _
                        SortOn:=xlSortOnValues, _
                        Order:=xlAscending, _
                        DataOption:=xlSortNormal
        .SetRange Range(RngStartingCell, Cells(RngStartingCell.Row, Columns.Count).End(xlToLeft)).EntireColumn
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        .SortFields.Clear
    End With
    
    'Setting RngTarget as the last cell of the list.
    Set RngTarget = RngStartingCell.End(xlDown)
    
    'Covering the whole list from the bottom up.
    Do Until RngTarget.Address = RngStartingCell.Address
        
        'Checking if the actual row has the same item as the row above.
        If RngTarget.Offset(0, 0).Value = RngTarget.Offset(-1, 0).Value And _
           RngTarget.Offset(0, 2).Value = RngTarget.Offset(-1, 2).Value Then
            
            'Making one row of the two.
            RngTarget.Offset(0, 1).Value = RngTarget.Offset(0, 1).Value + RngTarget.Offset(-1, 1).Value
            RngTarget.Offset(-1, 0).EntireRow.Delete
            
        Else
            Set RngTarget = RngTarget.Offset(-1, 0)
        End If
        
    Loop
    
    'Setting RngTarget as the last cell of the list.
    Set RngTarget = RngStartingCell.End(xlDown)
    
    'Covering the whole list from the bottom up.
    Do Until RngTarget.Address = RngStartingCell.Address
        
        'Counting how many rows with the ID reported in RngTarget are in the list.
        DblCounter01 = Excel.WorksheetFunction.CountIf(Range(RngStartingCell, RngTarget), RngTarget.Value)
        
        'Checking if there is more than 1 row with the same ID.
        If DblCounter01 > 1 Then
            
            'Cut-pasting the source data.
            RngTarget.EntireRow.Resize(1, Columns.Count - 3).Offset(0, 3).Cut RngTarget.Offset(-DblCounter01 + 1, 3)
            Set RngTarget = RngTarget.Offset(-DblCounter01, 0)
            RngTarget.Offset(DblCounter01, 0).EntireRow.Delete
        Else
            Set RngTarget = RngTarget.Offset(-DblCounter01, 0)
        End If
        
    Loop
    
    
End Sub

它会创建一个包含您正在寻找的结果的新工作表。如果您不希望它出现在新工作表中，而是想编辑源工作表本身，只需删除该行ActiveSheet.Copy After:=ActiveSheet.

这项任务很可能用更短的代码来完成。我选择了更长的方法，因为我想使用大量的基本命令；这样你就可以从中学到更多基本的东西。