Sub 处理拼读() 'name可以是中文
Dim startRow As Integer
Dim rowCount As Integer
startRow = Selection.Row
rowCount = Selection.Count
For r = 0 To rowCount - 1 '对每一条进行处理
Dim curRow As Integer
curRow = startRow + r
' == == == == == ==
' == == == == 固定复制
' == == == == == ==
Cells(curRow, "C") = Cells(curRow, "L") 'C列输入
Cells(curRow, "E") = Cells(curRow, "P") 'E列意思
Cells(curRow, "G") = Cells(curRow, "Q") 'G列声调
Cells(curRow, "J") = "[sound:" + Cells(curRow, "L") + ".mp3]" 'J列音频
' == == == == == ==
' == == == == 处理英语
' == == == == == ==
Dim English格 As Range
Set English格 = Cells(curRow, "O")
If Not (English格 = "") Then
Cells(curRow, "A") = "片假名" 'A列
Cells(curRow, "F") = English格 'F英语列
End If
' == == == == == ==
' == == == == 注音
' == == == == == ==
Dim 汉字格 As Range
Set 汉字格 = Cells(curRow, "M") '取M列的汉字
Dim cell_合成 As Range
Set cell_合成 = Cells(curRow, "D") 'D列合成假名
If Not (汉字格 = "") Then '汉字格不为空
Dim cell_平假名 As Range
Dim arr_汉字
Dim arr_假名
Dim str_合成 As String
Set cell_平假名 = Cells(curRow, "N")
' == == == == 切割
arr_汉字 = Split(汉字格, " ")
arr_假名 = Split(cell_平假名, " ")
If Not (UBound(arr_汉字) = UBound(arr_假名)) Then ' 如果长度不一致提示并跳过
MsgBox 汉字格, vbButtonType, "长度不一致"
With cell_合成
.Value = "------"
.Font.ColorIndex = 3
End With
Else
str_合成 = "" ' 重置
For j = LBound(arr_汉字) To UBound(arr_汉字)
Dim curStr As String
If arr_汉字(j) = arr_假名(j) Then
curStr = arr_汉字(j)
Else
curStr = arr_汉字(j) + "[" + arr_假名(j) + "]"
If Not (j = LBound(arr_汉字)) Then ' 第一个字了不用加空格
curStr = " " + curStr
End If
End If
str_合成 = str_合成 + curStr
Next
' 颜色代号0-8 白黑红绿蓝黄紫青
With cell_合成
.Value = str_合成
.Font.ColorIndex = 1
End With
End If
Else
cell_合成 = Cells(curRow, "L")
End If
' == == == == == ==
' == == == == 提问
' == == == == == ==
Dim type格 As Range
Set type格 = Cells(curRow, "A")
If type格 = "纯假名" Or type格 = "片假名" Or type格 = "句子假" Then
Cells(curRow, "B") = Cells(curRow, "E") 'B列提问
Else
Cells(curRow, "B") = Cells(curRow, "C") 'F列英语
End If
' 修改颜色
Select Case type格
Case "纯假名"
type格.Interior.Color = RGB(200, 230, 150) '绿色
Case "片假名"
type格.Interior.Color = RGB(140, 200, 250) '蓝色
Case "句子假"
type格.Interior.Color = RGB(240, 200, 100) '深橙色
Case "句子汉"
Debug.Print type格
type格.Interior.Color = RGB(250, 230, 180) '淡橙色
Case Else
type格.Interior.Color = xlNone '空
End Select
' == == == == == ==
' == == == == 类型
' == == == == == ==
Dim label格 As Range
Set label格 = Cells(curRow, "K")
Select Case type格
Case "纯假名"
label格 = "假名"
Case "片假名"
label格 = "片"
Case "句子假", "句子汉"
label格 = "句子"
Case Else
Debug.Print type格
label格 = "混"
End Select
Next
End Sub
评论