在Excel中利用VBA编写词组合，可用于起名或推广关键词

来源：互联网发布：mac 磁盘修复编辑：程序博客网时间：2024/05/25 19:58

1.打开Excel，按快捷键ALT+F11调出VBA编辑器，双击Sheet1,将以下代码拷贝，保存

Sub 两个词组合()
Dim a() As Variant, b As Integer, n As Integer
'定义一个数组,两个变量
b = WorksheetFunction.CountA(Range("a:a"))
'判断A列有多少个数据
ReDim a(b)
'重定义数组大小
For i = 1 To b
    a(i) = Range("a" & i)
Next i
'给数组赋值
For i = 1 To b
    n = 1
    For j = 1 To b
          If i <> j Then
          '判断各个数是否相等
          Cells(n, i + 2) = a(i) & " " & a(j)
          '生成各个数的组合,并输出到C列，上面 a(i) & " " & a(j)表示C列输出是关键词+空格+关键词。
          n = n + 1
          End If
Next j, i
End Sub

Sub 三个词组合()
Dim a() As Variant, b As Integer, n As Integer
'定义一个数组,两个变量
b = WorksheetFunction.CountA(Range("a:a"))
'判断A列有多少个数据
ReDim a(b)
'重定义数组大小
For i = 1 To b
    a(i) = Range("a" & i)
Next i
'给数组赋值
For i = 1 To b
    n = 1
    For j = 1 To b
      For x = 1 To b
          If i <> j And i <> x And j <> x Then
          '判断各个数是否相等
          Cells(n, i + 2) = a(i) & " " & a(j) & " " & a(x)
          '生成各个数的组合,并输出到C列
          n = n + 1
          End If
Next x, j, i
End Sub

Sub 清除表格内容()
    '行清除
    'a = 5 '从第五行开始
    'b = 65536
    'Sheet1.Rows(a & ":" & b).ClearContents '行清除内容
    'Sheet1.Rows(a & ":" & b).Clear'行全部清除

    '列清除
    a = 2 '从第二列开始
    b = 256
    With Sheet1
        .Range(.Cells(1, a), .Cells(1, b)).EntireColumn.ClearContents '列清除内容
    '    .Range(.Cells(1, a), .Cells(1, b)).EntireColumn.Clear '列全部清除
    End With
End Sub

2.关闭VBA界面

3.在Sheet1表中第一列输入你所要组合用的词，然后按ALT+F8键，选择两个词组合或三个词组合，点击执行，即可完成组合

4.若须清除组合结果，可以用同样方法执行清除表格内容