範例_字串切割與Do_While迴圈不定數量結果

 

練習檔 [下載]

這個範例是學員工作上的問題,

每天都需要將儲存格中的超連結取出到B欄中,

若儲存格中只有一個超連結還好解決,

可以用Find函數找中括弧位置,再用Mid函數切割,

剛好這個範例裡面不只一個超連結,

可能有兩個、三個甚至更多,

也就是數量不定,如果要用For迴圈,也要知道數量範圍,

所以只能用 Do While 迴圈了,

從第一個字找起,之後再從找到的位置加一再找了,該如何做。

預覽影片:

 

一、函數

=FIND(C$1,A2)

=FIND(D$1,A2)

=MID(A2,C2+1,D2-C2-1)

 

如果用VBA撰寫的程式

 

一、階段一,先撰寫只取一個超連結

外面的For迴圈是跑每一列,用 Instr函數找"【<"和">】",

分別放在將找到位置的值放在 a和b 中,

如果a或b為0,表示找不到。

 

Sub 字串切割()

    '1.迴圈範圍

    For i = 2 To Range("A2").End(xlDown).Row

        '2.取得頭尾位置與切割字串

        a = VBA.InStr(Cells(i, "A"), "【<")

        b = VBA.InStr(Cells(i, "A"), ">】")

        If a <> 0 Then

            '5.輸出結果

            Cells(i, "B") = Mid(Cells(i, "A"), a + 1, b - a)

        End If

    Next

End Sub

 

如果多個超連結,可以先多產生 a1和b1變數,預設值為 1,

即從頭找起,找到之後再把  a1和b1 加1之後繼續找,

直到找不到為止,Do While 後面就是邏輯,為 True 就繼續找,

反之就離開迴圈了。

 

Sub 字串切割_所有超連結()

    '1.迴圈範圍

    For i = 2 To Range("A2").End(xlDown).Row

        '兩個位置初始值,從1開始找

        a1 = 1

        b1= 1

        '2.取得頭尾位置與切割字串

        '當找到關鍵字就執行以下程序

        Do While InStr(a1, Cells(i, "A"), "【<") <> 0

            a = InStr(a1, Cells(i, "A"), "【<")

            b = InStr(b1, Cells(i, "A"),  ">】")

            S = S & Mid(Cells(i, "A"), a + 1, b - a) & Chr(10)

            a1 = a + 1

            b1 = b + 1

        Loop

        '輸出到B欄

        Cells(i, "B") = S

        '清空變數資料

        S = ""

    Next

End Sub

 

以下是清除資料的程式碼

 

Public Sub 清除()

    Range("B2:B" & Range("B2").End(xlDown).Row).ClearContents

End Sub

 

以上範例主要學會如何用 VBA的 Instr與Mid函數取出要的資料,

如果範圍不定,一定要懂得使用 Do While迴圈了。

 

教學影音(完整版在論壇):

 

教學影音完整版在論壇:

https://groups.google.com/forum/#!forum/scu_excel_vba2_107

 

EXCEL VBA進階班的課程規劃

 

主要是延伸入門課,延伸資料庫、多工作表、工作簿、網路爬蟲、視覺化報表等應用並與Python程式協同應用

單元01_資料拆解相關(VBA)

單元02_輸入自動化與表單設計

單元03_用ADO匯入與匯出資料庫

單元04_大量工作表合併與分割

單元05_資料查詢(篩選與分割工作表)

單元06_下載網路資料(YAHOO股市)

單元07_活頁簿與檔案處理(工作表分割與合併活頁簿)

單元08_視覺化報表與快速匯入圖片

 

其他相關學習:

函數東吳進修推廣部, EXCEL, EXCEL VBA 函數 程式設計 線上教學 excel vba 教學 excel vba指令教學 vba範例教學excel  excel vba教學視頻 函數教學 excel函數

arrow
arrow

    吳老師 發表在 痞客邦 留言(0) 人氣()