使用ExcelVbs来制作Anki的单词卡

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

评论