学以致用——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的强大！！！