錦子老師

我在「工作表1」工作表內有資料：

早：填入數值123456789…、晚：填入A1,A2,A3,A4,B5、夜：填入B1,B2,B3,B4

比如說在A3:R3儲存格，我輸入「早早早夜夜夜早早夜晚晚晚早早早晚晚早」，那如何寫VBA讓程式自動對照並填入「1,2,3,B1,B2,B3,4,5,B4,A1,A2,A3,6,7,8,A4,A5,9」。

請大家幫忙了，謝謝?！

Neish大神方法

按ALT+F11鍵開啟VBA視窗。

點取「插入 > 模組」指令。

輸入下列程式碼：

Sub test()

    Dim str_col As Integer

    Dim end_col As Integer

    Dim i As Integer

    Dim j As Integer

    Dim k As Integer

    end_col = Rows(3).Find("").Column - 1

    For str_col = 1 To end_col

        If Cells(3, str_col) = "早" Then

            i = i + 1

            Cells(4, str_col) = i

        ElseIf Cells(3, str_col) = "晚" Then

            j = j + 1

            Cells(4, str_col) = "A" & j

        ElseIf Cells(3, str_col) = "夜" Then

            k = k + 1

            Cells(4, str_col) = "B" & k

        End If

    Next

End Sub

按ALT+TAB鍵回到活頁簿視窗。

點取「檢視 > 巨集下方▼鈕 > 檢視巨集」指令。

在【巨集】對話方塊，點取「TEXT」項目，再點取「執行」鈕。

結果如下圖所示。

PCW大神方法

按ALT+F11鍵開啟VBA視窗。

點取「插入 > 模組」指令。

輸入下列程式碼：

Sub test1()

    Dim myRng As Range, rng As Range

    Dim i As Long, j As Long, k As Long

    Set myRng = Range("A3:R3")

    For Each rng In myRng

        Select Case rng

        Case "早"

            i = i + 1

            rng.Offset(1).Value = i

        Case "晚"

            j = j + 1

            rng.Offset(1).Value = "A" & j

        Case "夜"

            k = k + 1

            rng.Offset(1).Value = "B" & k

        Case Else

        End Select

    Next rng

End Sub

按ALT+TAB鍵回到活頁簿視窗。

點取「檢視 > 巨集下方▼鈕 > 檢視巨集」指令。

在【巨集】對話方塊，點取「TEXT1」項目，再點取「執行」鈕。

結果如下圖所示。