Excel VBA/英中對照之語意分析樣版

出自 青少年追求卓越
前往: 導覽搜尋
Option Explicit

Sub SplitEnglishAndChinese()         '本程序把英文和中文左並列的資料,改為上下分列
    Dim sht1 As Worksheet   '《輸入》
    Dim sht2 As Worksheet   ' 輸出文件
    Dim rng1 As Range       '《輸入》表的儲存格參考點
    Dim rng2 As Range       ' 輸出文件的儲存格參考點
    Dim i1 As Integer       '《輸入》表的列指標
    Dim i2 As Integer       ' 輸出文件的列指標
    Dim str As String       ' "第 "
    Dim n As Integer        ' 句子編號


' 以下是程式邏輯
    Application.ScreenUpdating = False
    
    Set sht1 = Worksheets("輸入")   'set 是將變數連結一個物件
    Set rng1 = sht1.Range("a1")
    Set sht2 = Sheets.Add(after:=Worksheets(Worksheets.Count))
    'sht2.Name = "輸出"
    Set rng2 = sht2.Range("a1")
    
    i1 = 0
    i2 = 0
    
    Do Until rng1.Offset(i1, 0).Value = "////"
    '每一格在此迴圈中處理
        Do Until rng1.Offset(i1, 0).Value = "////"
        '每一格的每一列在此迴圈中處理
        '處理格號只有一列
            str = Mid(rng1.Offset(i1, 0), 3, Len(rng1.Offset(i1, 0).Value) - 4)
            n = 1
            i1 = i1 + 1
        '處理句子,可以有很多句子,空白行結束格子
            Do Until rng1.Offset(i1, 0).Value = "" Or rng1.Offset(i1, 0).Value = "////"
            '每一個句子有英文
                rng2.Offset(i2, 0).Value = str & "—" & n     '格號和句子編號
                i2 = i2 + 1
                rng2.Offset(i2, 0).Value = rng1.Offset(i1, 0) '英文
                i2 = i2 + 1
                rng2.Offset(i2, 0).Value = rng1.Offset(i1, 0) '英文複製一列
                i2 = i2 + 1
                i1 = i1 + 1
            '每一個句子有中文
                rng2.Offset(i2, 0).Value = rng1.Offset(i1, 0) '中文
                i2 = i2 + 1
                i1 = i1 + 1
                n = n + 1
            Loop
            rng2.Offset(i2, 0).Value = rng1.Offset(i1, 0) '空白列
            i2 = i2 + 1
            i1 = i1 + 1
        Loop
    Loop
    Application.ScreenUpdating = True
    
    
End Sub