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

Question

每一行都有一个ID和一系列多种类型的灯具(类型)和电源(瓦特)。

​

​

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

如果在同一行中有2盏灯的功率(瓦特)和类型相等，则应在另一张表的类型列中插入一个字符串

1. 。

。

1. 如果在同一行中有不同功率(瓦特)或类型的灯具，则应使用相同的ID将其他类型的灯插入到第一行下面。

​

​

你们能帮帮我吗？

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。

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