Question

我的数据如下：

negative         Comment1    
neutral          Comment1    
positive         Comment1    
neutral          Comment1    
positive         Comment1    
negative         Comment1

我有一个编写的简单宏，可以执行三个步骤：

在第一列中找到最常用的单词
删除所有不包含该单词的其他行
删除所有重复的行。

基本上，我的宏会查看第一栏中写的内容，并根据最常用的单词将整个块减少到仅一行。

一个例子：

到目前为止，这是可行的，但是现在我想将同一宏应用于整个工作表中的不同“块”。实际上，我的数据看起来像这样：

positive         Comment1    
neutral          Comment1    
positive         Comment1    
negative         Comment1    
positive         Comment2    
neutral          Comment2    
positive         Comment2    
negative         Comment3    
negative         Comment3    
negative         Comment3    
positive         Comment3

我想本质上使用我的宏将其简化为：

positive         Comment1    
positive         Comment2    
negative         Comment3

到目前为止，我的宏仅适用于一条评论。例如，有没有一种方法可以检测到注释中的差异，从而可以使我的宏循环遍历相似注释的每个“块”？非常感谢您的任何帮助，谢谢。

到目前为止，这是我的宏：

Sub MostFrequent()
Dim rng As Range
Dim WorkRng As Range
Set dic = CreateObject("scripting.dictionary")
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
xMax = 0
xOutValue = ""
For Each rng In WorkRng
    xValue = rng.Value
    If xValue <> "" Then
        dic(xValue) = dic(xValue) + 1
        xCount = dic(xValue)
        If xCount > xMax Then
            xMax = xCount
            xOutValue = xValue
        End If
    End If
Next

Dim xRow As Range
Dim xStr As String
On Error Resume Next
xTitleId = "KutoolsforExcel"
xStr = xOutValue
Application.ScreenUpdating = False
For i = WorkRng.Rows.Count To 1 Step -1
    Set xRow = WorkRng.Rows(i)
    Set rng = xRow.Find(xStr, LookIn:=xlValues)
    If rng Is Nothing Then
       xRow.EntireRow.Delete
    End If
Next
Application.ScreenUpdating = True

 With ActiveSheet
        Set rng = Range("A1", Range("B1").End(xlDown))
        rng.RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
    End With
End Sub

Answer 1

假设您实际上只使用A列和B列。

下面的代码将在C，D和E列上插入公式。（我实际上只能使用1个公式，剩下的3个都可以更容易理解我在做什么）

使用这些公式，我得到了时间，并且用“语义”重复了一条评论。如果百分比低于50％，则表示它不是最常见的，因此将被删除。您会看到最常见的重复项，我会删除重复项和公式。

Sub delRows()
    Dim lastRow As Long, i As Long, wk As Workbook, repeatDel As Boolean
    Set wk = ThisWorkbook
    Application.ScreenUpdating = False
    With wk.Sheets("Sheet1")
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(2, 3).Formula = "=CONCAT(MID(B2,1,240),A2)"
        .Cells(2, 4).Formula = "=COUNTIF(C:C,C2)"
        .Cells(2, 5).Formula = "=D2/COUNTIF(B:B,B2)"
        'FillDown formulas
        .Range("C2:E" & lastRow).FillDown
        'When deleting rows, you should loop from bottom to top.
        For i = lastRow To 2 Step -1
            If .Cells(i, 5) < 0.5 Then
                'Delete least frequent
                .Cells(i, 5).EntireRow.Delete
                repeatDel = True
            End If
        Next i
        'Remove duplicates and Formulas
        .Columns("A:E").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes
        .Columns("C:E").ClearContents
    End With
    Application.ScreenUpdating = True
End Sub

有没有一种方法可以为列中的不同块重复一个宏？

1 个答案: