公告版位

目前分類:02_EXCEL VBA自動化教學 (118)

瀏覽方式: 標題列表 簡短摘要

範例_字串切割與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函數

文章標籤

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

直接用VBA取得儲存格中的數字或英文資料

 

之前常有同學問到,若是儲存格中,中、英、數字資料夾雜,

若只想留下數字部分,該怎麼做,有沒有函數可以解決,

不懂VBA,這個問題將非常麻煩,資料少還可以土法煉鋼,

慢慢複製貼上,但若資料非常巨量,將是巨大麻煩,

本文分享如何簡單解決這個問題,

雖然用MID、CODE、ROW、IFFERROR、SUM加上陣列計算數字個數,

已經夠複雜的了,若要再取出數字部分,那就更加困難,

建議,這麼複雜的事情,還是改為VBA來做會比較適合,

也許直接跳過 EXCEL裡的函數,

直接寫 VBA 回更簡單,以下簡單說明如下。


預覽畫面:

 

VBA部分:

 

階段一:

Sub 數字個數()

    For i = 2 To 9

        c = 0

        For j = 1 To Len(Cells(i, "A"))

            If VBA.Asc(Mid(Cells(i, "A"), j, 1)) > 47 And VBA.Asc(Mid(Cells(i, "A"), j, 1)) < 58 Then

                c = c + 1

            End If

        Next

        Cells(i, "B") = c

    Next

End Sub

 

Sub 非數字個數()

    For i = 2 To 9

        '1.字數迴圈範圍

        c = 0

        For j = 1 To Len(Cells(i, "A"))

            '2.判斷是否為數字

            If VBA.Asc(Mid(Cells(i, "A"), j, 1)) <= 47 Or VBA.Asc(Mid(Cells(i, "A"), j, 1)) >= 58 Then

                '3.如果是就+1

                c = c + 1

            End If

        Next

        '4.傳給B欄i列的儲存格

        Cells(i, "C") = c

    Next

End Sub

 

Sub 留下數字()

    For i = 2 To 9

        '1.字數迴圈範圍

        S = ""

        For j = 1 To Len(Cells(i, "A"))

            '2.判斷是否為數字

            If VBA.Asc(Mid(Cells(i, "A"), j, 1)) > 47 And VBA.Asc(Mid(Cells(i, "A"), j, 1)) < 58 Then

                '3.如果是就+1

                S = S & Mid(Cells(i, "A"), j, 1)

            End If

        Next

        '4.傳給B欄i列的儲存格

        Cells(i, "D") = S

    Next

End Sub

 

Sub 留下英文()

    For i = 2 To 9

        '1.字數迴圈範圍

        S = ""

        For j = 1 To Len(Cells(i, "A"))

            '2.判斷是否為數字

            If VBA.Asc(VBA.UCase(Mid(Cells(i, "A"), j, 1))) > 64 And VBA.Asc(VBA.UCase(Mid(Cells(i, "A"), j, 1))) < 91 Then

                '3.如果是就+1

                S = S & Mid(Cells(i, "A"), j, 1)

            End If

        Next

        '4.傳給B欄i列的儲存格

        Cells(i, "E") = S

    Next

End Sub

 

Public Sub 留下中文()

    For i = 2 To 9

        '1.字數迴圈範圍

        S = ""

        For j = 1 To Len(Cells(i, "A"))

            '2.判斷是否為數字

            If VBA.Asc(Mid(Cells(i, "A"), j, 1)) < 0 Or VBA.Asc(Mid(Cells(i, "A"), j, 1)) > 127 Then

                '3.如果是就+1

                S = S & Mid(Cells(i, "A"), j, 1)

            End If

        Next

        '4.傳給B欄i列的儲存格

        Cells(i, "F") = S

    Next

End Sub

 

Public Sub 清除()

    Range("B2:F9").ClearContents

 

End Sub

 

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

 

教學影音完整版在論壇:

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函數

文章標籤

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

EXCEL匯出資料到MYSQL與PHP、Phthon、R、APP共用資料

 

將資料存放在MYSQL可以解決多平台不同開發工具共用資料問題,

PHP、Phthon、R、APP的共用資料,EXCEL又是最普遍的辦公室應用程式,

所以若能將兩者串連,相信可以讓資料運用更加彈性。

此外,一般會和EXCEL VBA連接的大多都是用到ACCESSMS SQL資料庫

但ACCESS資料庫與MS SQL資料庫都不是自由軟體,所以會有授權費用

另外ACCESS資料庫基本上是單機型的資料庫,對於多台電腦連線就會有問題

雖然可以透過網芳共用來解決,但還是非常的麻煩的,

所以改用MYSQL資料庫,似乎就可以解決前兩者資料庫的問題,

首先它是自由軟體,再者它也可以讓大家在同個網路區段裡連線。

以下介紹如何安裝EXCEL VBA連線

這篇文章主要是在VBA中呼叫ADO,並用SQL語言和MYSQL溝通,

淺顯易懂,而且容易操作,和大家分享,

不過比較困難的部分,

可能要注意:

1.Windoms有沒有安裝IIS,有就一定要停止,或換PORT號。

2.執行ADO一定要安裝MYSQL的驅動程式。

3.連線字串可以參考 ConnectionStrings 網站:https://www.connectionstrings.com/

 

預覽畫面:

 

可以先參考:

PHP與雲端資料庫教學懶人包(2015)

https://terry55wu.blogspot.tw/p/blog-page_18.html

 

PHP雲端資料庫教學之1(打造PHP與MySQL環境)

https://terry55wu.blogspot.tw/2015/03/php1phpmysql.html

 

這是PHP雲端資料庫第一次上課,主要是了解學生的程度學習需求
並且打造PHP與MySQL環境下載XAMPP安裝的懶人包 [下載]

 

1.XAMPP563.zip解壓縮到D碟與執行setup_xampp.batxampp-control.exe

 

 

啟動Apache 與 MySQL (注意要允許防火牆)

 

 

1.如何設定XAMPP與MQSQL的安全性

 

 

2.如何新增MQSQL資料庫與資料表

建立資料庫

3.建立資料表

 

建立問題2資料表

 

 

INSERT INTO `問題2`(`編號`, `品名`, `單價`, `數量`, `小計`, `地區`) VALUES ('0001','玩具',399,46,18354,'東')

 

 

程式碼:

Sub 新增單筆()

 

   r = Range("A2").End(xlDown).Row

   A = Cells(r, 1)

   B = Cells(r, 2)

   C = Cells(r, 3)

   D = Cells(r, 4)

   E = Cells(r, 5)

   F = Cells(r, 6)

   Call 利用ADO新增資料(A, B, C, D, E, F)

   MsgBox "資料新增成功!!", vbInformation

End Sub

Sub 新增全部()

 

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

       A = Cells(i, 1)

       B = Cells(i, 2)

       C = Cells(i, 3)

       D = Cells(i, 4)

       E = Cells(i, 5)

       F = Cells(i, 6)

       Call 利用ADO新增資料(A, B, C, D, E, F)

       Application.StatusBar = "新增到第" & i - 1 & "筆"

   Next

   MsgBox "資料新增全部成功!!", vbInformation

End Sub

Sub 利用ADO新增資料(A, B, C, D, E, F)

 

   '1.建立Connection物件

   Set myCon = CreateObject("ADODB.Connection")

   '2.連結資料庫

   myCon.Open "Driver={MySQL ODBC 5.2 UNICODE Driver};Server=127.0.0.1;Database=問題2;User=root;Password=1234;Option=3;"

   '3.建立Recordset物件&連結資料表

   Sql = "INSERT INTO 問題2 (編號, 品名, 單價, 數量, 小計, 地區) VALUES ('" & _

   A & "','" & B & "', " & C & ", " & D & "," & E & ",'" & F & "')"

   'MsgBox (Sql)

   Set myRs = myCon.Execute(Sql)

End Sub

Public Sub 刪除EXCEL資料()

 

   Range("A2:F" & Range("A2").End(xlDown).Row).ClearContents

End Sub

Sub 從MYSQL資料庫全部匯入()

 

   '1.建立Connection物件

   Set myCon = CreateObject("ADODB.Connection")

   '2.連結資料庫

   'myCon.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & ThisWorkbook.Path & "\問題1.accdb;"

   myCon.Open "Driver={MySQL ODBC 5.2 UNICODE Driver};Server=127.0.0.1;Database=問題2;User=root;Password=1234;Option=3;"

   '3.建立Recordset物件&連結資料表

   Sql = "Select * from 問題2"

   'MsgBox (Sql)

   Set myRs = myCon.Execute(Sql)

   Range("A2").CopyFromRecordset myRs

End Sub

Sub 刪除所有MYSQL資料()

 

   '1.建立Connection物件

   Set myCon = CreateObject("ADODB.Connection")

   '2.連結資料庫

   'myCon.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & ThisWorkbook.Path & "\問題1.accdb;"

   myCon.Open "Driver={MySQL ODBC 5.2 UNICODE Driver};Server=127.0.0.1;Database=問題2;User=root;Password=1234;Option=3;"

   '3.建立Recordset物件&連結資料表

   Sql = "Delete from 問題2"

   'MsgBox (Sql)

   Set myRs = myCon.Execute(Sql)

End Sub

 

**如何遠端連線

1.新增使用者

 

2.設定權限(任意主機)

 

3.修改連線主機的IP或名稱


 

**新增全部_進度狀態列

 

完成畫面:

 

 

表單屬性

 

標籤屬性

 

 

Private Sub UserForm_Activate()

 

   '狀態列歸零

   PB.Width = 0

   '取得總列數

   r = Range("A2").End(xlDown).Row

   For i = 2 To r

       A = Cells(i, 1)

       B = Cells(i, 2)

       C = Cells(i, 3)

       D = Cells(i, 4)

       E = Cells(i, 5)

       F = Cells(i, 6)

       Call 利用ADO新增資料(A, B, C, D, E, F)

       '更新狀態列用400去除

       PB.Width = (i - 1) * (400 / (r - 1))

       '更新表單

       home.Repaint

       Application.StatusBar = "新增到第" & i - 1 & "筆"

   Next

   home.Hide

End Sub


 

Sub 新增全部_進度狀態列()

 

   home.Show

   MsgBox "資料新增全部成功!!", vbInformation

End Sub

 

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

 

教學影音完整版在論壇:

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

 

課程特色:

1.如何將函數轉成VBA2.VBA與資料庫快速結合

EXCEL函數 VBA程式設計資料庫是分別屬於三個領域的知識,

但卻是目前大家都需要的一項專業技能,要把三者融合的很好實在非常不容易,

剛好我有近20年的VB程式設計與資料庫設計的經驗,

教EXCEL函數與相關課程也有多年,因此清楚如何把最重要的知識教給大家,

ADO資料庫設計的知識非常多,但根據我多年的設計實務經驗,

覺得最重要的是掌握SQL語言,就可以輕易的完成查詢、新增、修改與刪除等功能,

就可以輕易的完成自己想處理的大量資料,大大提高工作效率了!

 

完整教學影音DVD申請:http://goo.gl/ZlBZE

 

其他相關學習:

 

    1.EXCEL VBA設計(自強基金會2012)第4次上課

    http://terry55wu.blogspot.tw/2012/03/excel-vba20124.html

     

    2.如何把EXCEL"函數"變為 "VBA"?自強基金會2012第5次上課

    http://terry55wu.blogspot.tw/2012/04/excel-vba.html

     

    3.自強基金會2012第8次上課

    http://terry55wu.blogspot.tw/2012/05/excel-vba20128.html

     

    4.自強基金會2012第9次上課

    http://terry55wu.blogspot.tw/2012/05/excel-vba20129.html

     

    5.EXCEL_VBA與資料庫--自強基金會2012(Ending)

    http://terry55wu.blogspot.tw/2012/07/excelvba-2012ending.html

     

    EXCEL,VBA,函數,文化大學推廣部,EXCEL VBA 函數 程式設計 線上教學 excel vba 教學 excel vba指令教學 vba範例教學excel  excel vba教學視頻 excel函數教學 excel函數 MYSQL

    文章標籤

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

    EXCEL VBA用XMLHTTP物件抓取外匯資料:

    如何用XMLHTTP物件直接抓取台銀外匯的資料到EXCEL中,之前用匯入資料從WEB的方式實際上就是用QueryTable物件效果不彰,主要原因是QueryTable顧名思義,就是查詢原始碼裡的Table標籤,再選擇下載到EXCEL,若是網頁中沒有Table標籤,或是不是表格形式的資料,就有無法下載,或是下載後格式錯亂問題,因此這次分享用XMLHTTP物件代勞

     

    預覽畫面:

     

    完成畫面:

     


    網址:

     

    一.利用台銀官網的CSV檔抓取資料

     

    1.下載整個資料到A1

    Public Sub XMLHTTP()

       '1.載入XMLHTTP物件為HttpReq物件變數

       Set HttpReq = CreateObject("MSXML2.XMLHTTP.3.0")

       '2.用Open方法開啟 CSV檔

       HttpReq.Open "GET", "http://rate.bot.com.tw/xrt/flcsv/0/day", False

       '3.傳送需求給伺服器

       HttpReq.send

       '4.將結果顯示在 A1儲存格

       Range("A1") = HttpReq.responseText

    End Sub

    2.下載到A欄

    Public Sub XMLHTTP_下載到A欄()

       '調整第1欄寬為100

       Columns(1).ColumnWidth = 100

       '建立物件變數HttpReq,取用XMLHTTP物件以抓取網路資料

       Set HttpReq = CreateObject("MSXML2.XMLHTTP.3.0")

       HttpReq.Open "GET", _

       "http://rate.bot.com.tw/xrt/flcsv/0/day", _

       False

       HttpReq.send

       S = HttpReq.responseText

       '切割位置從1開始

       iStart = 1

       '輸出到EXCEL從第1列開始

       i = 1

       Do While VBA.InStr(iStart, S, vbCrLf) <> 0

           '找換行位置

           iEnd = VBA.InStr(iStart, S, vbCrLf)

           '切割一行

           Sline = Mid(S, iStart, iEnd - iStart)

           ''切割位置+1繼續找

           iStart = iEnd + 2

           Cells(i, "A") = Sline

           i = i + 1

       Loop

       '最後一筆沒有換行會少一筆(切割為最後位置+1到最後)

       Sline = Mid(S, iEnd + 1, Len(S))

       Cells(i, "A") = Sline

       '顯示訊息

       MsgBox "下載完畢!!", vbInformation

    End Sub

    3.先錄製資料剖析巨集,再分割A欄與刪除不要的欄

    Sub 資料剖析()

       '1.選取A1

       Range("A1").Select

       '2.CTRL向右下下選取

       Range(Selection, Selection.End(xlDown)).Select

       '3.資料剖析,不匯入遠期

       Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _

           TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False