VBA 分类关健词同时排除所包含词根。

查看 51|回复 2
作者:吴虾咪   
文件地址: https://wufeitao.lanzoub.com/imiaN0x08r7g
表一:
[i]
表二:
[i]
表三:
[i]
两里面有个是别个老师弄的,高手看能修改一下(主要是同时排除)
主要生成自动分计划,就是把自义的词根归类到所属自定义的计划单元。就像分关健词类似。区别在可自定义计划单元加上可排除词根。
匹配类型:包含性匹配  
如 计划:论坛  单元:网站名称
关健词为以下:
吾爱论坛
我爱吾爱论坛
国内最好的论坛是吾爱破解吗
吾爱是餐饮网店吗
52pojie是什么网站
我来发贴帮助
求助吾爱高手
这是一个好网站
如求包含的词根是:吾爱   52pojie  排除的词根是:求助  餐饮
最终执行结果是:
计划                单元                    关健词
论坛                               网站名称                                    吾爱论坛
论坛                               网站名称                                   我爱吾爱论坛
论坛                              网站名称                                    国内最好的论坛是吾爱破解吗
论坛                             网站名称                                     52pojie是什么网站
未分配单元的关健词
我来发贴帮助
求助吾爱高手
吾爱是餐饮网店吗
这是一个好网站
==============就像下方这样子的
[i]

吾爱, 词根

gc588   

Sub 自动分计划()
    Dim sourceList(1 To 8, 1 To 3) As String '原始数据(假设有8个关键词)
    Dim kwList() As String '关键词数组
    Dim planList() As String '计划单元数组
    Dim rootList() As String '需要分配的词根数组
    Dim excludeRootList() As String '需要排除的词根数组
    Dim i As Integer, j As Integer '计数器
   
    '填充原始数据
    sourceList(1, 1) = "论坛"
    sourceList(1, 2) = "网站名称"
    sourceList(1, 3) = "吾爱论坛"
    sourceList(2, 1) = "论坛"
    sourceList(2, 2) = "网站名称"
    sourceList(2, 3) = "我爱吾爱论坛"
    sourceList(3, 1) = "论坛"
    sourceList(3, 2) = "网站名称"
    sourceList(3, 3) = "国内最好的论坛是吾爱破解吗"
    sourceList(4, 1) = "论坛"
    sourceList(4, 2) = "网站名称"
    sourceList(4, 3) = "52pojie是什么网站"
    sourceList(5, 1) = ""
    sourceList(5, 2) = ""
    sourceList(5, 3) = "我来发贴帮助"
    sourceList(6, 1) = ""
    sourceList(6, 2) = ""
    sourceList(6, 3) = "求助吾爱高手"
    sourceList(7, 1) = ""
    sourceList(7, 2) = ""
    sourceList(7, 3) = "吾爱是餐饮网店吗"
    sourceList(8, 1) = ""
    sourceList(8, 2) = ""
    sourceList(8, 3) = "这是一个好网站"
   
    '将关键词、计划单元、需要分配的词根和需要排除的词根存入数组
    kwList = Array("吾爱", "52pojie")
    planList = Array("论坛-网站名称")
    rootList = Array("吾爱")
    excludeRootList = Array("求助", "餐饮")
   
    '遍历所有关键词
    For i = 1 To UBound(sourceList, 1)
        Dim flag As Boolean '标记是否需要排除
        
        '判断是否需要排除
        For Each exRoot In excludeRootList
            If InStr(sourceList(i, 3), exRoot) > 0 Then
                flag = True '如果包含需要排除的词根,将flag设置为True
                Exit For
            End If
        Next exRoot
        
        If Not flag Then '如果不需要排除
            '遍历所有需要分配的词根
            For Each root In rootList
                '判断是否包含需要分配的词根
                If InStr(sourceList(i, 3), root) > 0 Then
                    '将数据添加到Excel表格中
                    j = j + 1
                    Worksheets("Sheet1").Range("A" & j) = sourceList(i, 1)
                    Worksheets("Sheet1").Range("B" & j) = sourceList(i, 2)
                    Worksheets("Sheet1").Range("C" & j) = sourceList(i, 3)
                    Exit For '只要匹配到一个需要分配的词根就退出循环
                End If
            Next root
        End If
    Next i
   
    '输出未分配单元的关键词
    j = j + 2
    Worksheets("Sheet1").Range("A" & j) = "未分配单元的关键词"
    For i = 1 To UBound(sourceList, 1)
        Dim flag As Boolean '标记是否包含需要分配的词根
        
        '判断是否包含需要分配的词根
        For Each root In rootList
            If InStr(sourceList(i, 3), root) > 0 Then
                flag = True '如果包含需要分配的词根,将flag设置为True
                Exit For
            End If
        Next root
        
        If Not flag Then '如果不包含需要分配的词根
            j = j + 1
            Worksheets("Sheet1").Range("C" & j) = sourceList(i, 3)
        End If
    Next i
End Sub
吴虾咪
OP
  


gc588 发表于 2023-5-23 10:29
Sub 自动分计划()
    Dim sourceList(1 To 8, 1 To 3) As String '原始数据(假设有8个关键词)
    Dim k ...

老师,出现当前范围内的声明重复。
老师,我这个计划,单元有很多。不是固定名称的,关健词也有很多的。上面图片的是大概举例。老师要是有时间麻烦下载https://wufeitao.lanzoub.com/imiaN0x08r7g 文件看下或原有上的改一下。他是完全匹配的,看能改成(有包含词根)就可匹配。同时排除有包含词根的。麻烦老师。
您需要登录后才可以回帖 登录 | 立即注册

返回顶部