根据 Excel 中的两个或多个条件插入行

Question

每一行都有一个 ID 和多个类型的序列 lamps（类型）和功率（瓦特）

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

如果同一行有2个lamp功率（瓦特）和类型都相等，则在类型栏中插入一个字符串type+power另一个 sheet.
如果同一行中有不同功率（瓦特）或类型的lamp，则应在第一行下方插入其他类型的lamp同一个身份证。例如：

你们能帮帮我吗？

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

它会创建一个新的 sheet，其中包含您要查找的结果。如果您不希望它出现在新的 sheet 中，而是想编辑源代码 sheet 本身，只需删除行 ActiveSheet.Copy After:=ActiveSheet.

该任务很可能用更短的代码完成。我选择了更长的方法，因为我想使用大量的基本命令；这样你可能会从中学到更多基础知识。

根据 Excel 中的两个或多个条件插入行

Insert rows based on two or more conditions in Excel

excel

vba

rows

multiple-columns