学以致用——ikb知识库英文词条词频分析-Part3-使用Excel制作高频词标签云（VBA）

高频词用标签云表现出来还是很漂亮的，在网上下载的刘万祥老师的标签云模板，修改后即可为我所用，制作出非常漂亮而具有统计意义的标签云。

VBA代码：

Sub SetTagSize()

    Application.CalculateFull '刷新随机数，正式不需要

    Dim str As String
    Dim l As Long
    str = ""

    For i = 5 To 59  '依次拼接各高频词，生成长文本
        str = str + Range("C" & i).Value & "  "
    
    Next

    ActiveSheet.Shapes("TagCloudBox").Select    '选中标签云容器，即标签云文本框
    Selection.Characters.Text = str             '将拼接好的长文本赋值给标签云文本框
    Selection.Characters.Font.Size = 8          '标签云字号为8
    Selection.Characters.Font.Name = "Arial"    '标签云字体为Arial
    
    
    l = 1

    For i = 5 To 59

    With Selection.Characters(Start:=l, Length:=Len(Range("C" & i).Value)).Font '逐词按照权重大小调整字体及颜色，突出显示排名靠前的高频词
      '  .Name = "Arial"
      '  .FontStyle = "常规"
        .Size = Range("E" & i).Value
      '  .Strikethrough = False
      '  .Superscript = False
      '  .Subscript = False
      '  .OutlineFont = False
      '  .Shadow = False
      '  .Underline = xlUnderlineStyleNone
        .ColorIndex = Range("F" & i).Value
    End With

    l = l + Len(Range("C" & i).Value) + 2

    Next i
        

End Sub

含数字版：

Sub SetTagSize3()   '含数字

    Application.CalculateFull  '刷新随机数，正式不需要

    Dim str As String
    str = ""
    For i = 5 To 69
    
        str1 = Range("C" & i).Value
        str2 = "(" & Application.WorksheetFunction.Text(Range("D" & i).Value, 0) & ")"
               
        str = str + str1 + str2 + "  "
    
    Next

    ActiveSheet.Shapes("TagCloudBox").Select
    Selection.Characters.Text = str
    Selection.Characters.Font.Size = 8
    Selection.Characters.Font.Name = "Arial"

    
    
    l = 1

    For i = 5 To 69

    With Selection.Characters(Start:=l, Length:=Len(Range("C" & i).Value)).Font
      '  .Name = "Arial"
      '  .FontStyle = "常规"
        .Size = Range("E" & i).Value
      '  .Strikethrough = False
      '  .Superscript = False
      '  .Subscript = False
      '  .OutlineFont = False
      '  .Shadow = False
      '  .Underline = xlUnderlineStyleNone
        .ColorIndex = Range("F" & i).Value
    End With

    l = l + Len(Range("C" & i).Value) + Len(Application.WorksheetFunction.Text(Range("D" & i).Value, 0)) + 4

    Next i
        

End Sub

单元格版：

Sub SetTagSize2()  '在单元格中

    Application.CalculateFull '刷新随机数，正式不需要
          
    For i = 5 To 69
        
     Range("C" & i).Select
    'Range("C" & i, "D" & i).Select
    With Selection.Font
    '    .Name = "Arial"
        .Size = Range("E" & i).Value
    '    .Strikethrough = False
    '    .Superscript = False
    '    .Subscript = False
    '    .OutlineFont = False
    '    .Shadow = False
    '    .Underline = xlUnderlineStyleNone
        .ColorIndex = Range("F" & i).Value
    End With
      
    Next i
    
    Range("C5").Select
   

End Sub

制作好的ikb英文词条的标签云（非常漂亮！）：

含数字版：

不含数字版：

单元格版：

后记：

再次感受到了Excel的强大！！！