高频词用标签云表现出来还是很漂亮的,在网上下载的刘万祥老师的标签云模板,修改后即可为我所用,制作出非常漂亮而具有统计意义的标签云。
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的强大!!!