2120Excel VBA對照字串並自動按順序排列

Excel VBA對照字串並自動按順序排列

2120

Excel VBA對照字串並自動按順序排列

實用性

●○○

難易度

●○○○

範本檔

2120.XLSX

我在「工作表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」項目,再點取「執行」鈕。

設定取消廣告分潤

結果如下圖所示。