"Excel VBA/英中對照之語意分析樣版" 修訂間的差異

出自 青少年追求卓越
前往: 導覽搜尋
(已建立頁面,內容為 "<pre> Option Explicit Sub SplitEnglishAndChinese() '本程序把英文和中文左並列的資料,改為上下分列 Dim sht1 As Worksheet '《英...")
(無差異)

於 2018年12月10日 (一) 09:02 的修訂

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