吳老師教學部落格(痞客邦分站)

    If 平均成績 >= 60 Then

        成績函數 = "合格"

    Else

        成績函數 = "不合格"

    End If

但要如何在別的電腦使用這些自訂函數呢？

這是很多學會VBA自訂函數的學員常問的問題，

當然如果懂得複製貼上程式碼到VBA的模組那就沒什麼問題了，

但若是給一班完全沒學過VBA的使用者，

那就可以用安裝增益集的方式來安裝所有VBA寫的自訂函數。

不過在分享這些自行撰寫的VBA自訂函數會有智慧權的問題，

建議可以先把自己寫的VBA程式加上密碼。

1.加密

請他另存為增益集

Sub 批次篩選業務()

'關閉畫面更新

   Application.ScreenUpdating = False

   Sheets(1).Select

   Call 批次刪除工作表

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

        X = Sheets("清單").Cells(i, "A")

        '1.游標放B1

        Range("B1").Select

        '2.篩選

        Selection.AutoFilter

        ActiveSheet.Range("$A$1:$L$2500").AutoFilter Field:=3, Criteria1:=X

        '3.複製

        Range("A1").Select

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

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

        Selection.Copy

        '4.新增工作表

        Sheets.Add After:=Sheets(Sheets.Count)

        Sheets(Sheets.Count).Name = X

        '5.貼上

        Range("A1").Select

        ActiveSheet.Paste

        '6.自動調整欄寬

        Selection.Columns.AutoFit

        Range("A1").Select

        '7.切回原工作表

        Sheets(1).Select

        Application.CutCopyMode = False

        '8.取消篩選

        Selection.AutoFilter       

        Range("A1").Select

    Next

 Application.ScreenUpdating = True

End Sub

Public Sub 移除重複()

   '排序

   Range("A1").CurrentRegion.Select

   '遞增xlAscending或1、遞減xlDescending或2

   Selection.Sort Key1:=Range("A1"), Order1:=1, Header:=xlYes

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

   For i = r To 2 Step -1

       'Cells(i, "A").Select

       If Cells(i, "A") = Cells(i - 1, "A") Then

           Rows(i - 1).Delete

       End If

   Next

End Sub

Sub 批次篩選(清單 As String, 欄位 As Integer)

   'On Error Resume Next

   Application.ScreenUpdating = False

   Call 批次刪除工作表

   r = Sheets("清單").Range(清單 & "2").End(xlDown).Row

   For i = 2 To r

       Application.StatusBar = "目前進度：總共筆數：" & r - 1 & " 進行筆數：" & i - 1

       X = Sheets("清單").Cells(i, 清單)

       '1.游標放B1

       Range("B1").Select

       '2.篩選

       Selection.AutoFilter

       ActiveSheet.Range("$A$1:$L$2500").AutoFilter Field:=欄位, Criteria1:=X

       '3.複製

       Range("A1").Select

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

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

       Selection.Copy

       '4.新增工作表

       Sheets.Add After:=Sheets(Sheets.Count)

       Sheets(Sheets.Count).Name = X

       '5.貼上

       Range("A1").Select

       ActiveSheet.Paste

       '6.自動調整欄寬

       Selection.Columns.AutoFit

       Range("A1").Select

       '7.切回原工作表

       Sheets(1).Select

       Application.CutCopyMode = False

       '8.取消篩選

       Selection.AutoFilter

       Range("A1").Select

   Next

   Application.ScreenUpdating = True

End Sub

    Call 批次篩選("A", 3)

End Sub

    Call 批次篩選("B", 4)

End Sub

   Call 批次篩選("C", 5)

End Sub

   Call 批次篩選("D", 12)

關於資料查詢部分，EXCEL的基本查詢有檢視與參照的相關函數，

最常用的有VLOOKUP等函數，

但查詢的功能很有限，實在無法達到自動化的目的，

所以如果要查詢更複雜切大量的資料，可以用資料庫的查詢功能，

可以藉由SQL語法的 Select敘述，達成所需要的效果，

但若只是單純的EXCEL資料，則可以藉由篩選功能完成，

若需要達到自動化目的，可以配合巨集錄製與修改。

以下屆由問題05範例來說明。

練習錄製並修改篩選業務

Sub 篩選業務()

    X = InputBox("請輸入業務姓名!!")

    '1.游標放B1

    Range("B1").Select

    '2.篩選

    Selection.AutoFilter

    ActiveSheet.Range("$A$1:$L$2500").AutoFilter Field:=3, Criteria1:=X

    '3.複製

    Range("A1").Select

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

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

    Selection.Copy

    '4.新增工作表

    Sheets.Add After:=Sheets(Sheets.Count)

    Sheets(Sheets.Count).Name = X

    '5.貼上

    Range("A1").Select

    ActiveSheet.Paste

    '6.自動調整欄寬

    Selection.Columns.AutoFit

    Range("A1").Select

    '7.切回原工作表

    Sheets(1).Select

    '8.取消篩選

    Selection.AutoFilter

   '9.切回到A1

   Range("A1").Select

End Sub

Sub 篩選業務_簡化()

   X = InputBox("請輸入業務姓名!!")

   '2.篩選

   Sheets(1).Range("$A$1:$L$" & Range("A1").End(xlDown).Row).AutoFilter Field:=3, Criteria1:=X

   '3.複製

   Range("A1").CurrentRegion.Copy

   Range("A1").CurrentRegion.select

  Selection.copy

   '4.新增工作表

   Sheets.Add After:=Sheets(Sheets.Count)

   Sheets(Sheets.Count).Name = X

   '5.貼上

   Range("A1").Select

   ActiveSheet.Paste

   '6.自動調整欄寬

   Columns("A:L").AutoFit

   Range("A1").Select

   '7.切回原工作表

   Sheets(1).Select

   '8.取消篩選

   Selection.AutoFilter

   Range("A1").Select

End Sub

方法2：

Sub 篩選業務_防呆()

   x = InputBox("請輸入業務姓名!!")

   '防呆1：如何防止查詢已存在的名稱而產生錯誤

   For i = 2 To Sheets.Count

       If x = Sheets(i).Name Then

           'MsgBox "工作表已存在請先刪除!!"

           'Exit Sub

           Application.DisplayAlerts = False

           Sheets(i).Delete

           Application.DisplayAlerts = True

           Exit For            

       End If

   Next

   '防呆2：無填寫

   If x = "" Then

       MsgBox "請務必輸入資料!!"

       Exit Sub

   End If    

   '2.篩選

   Selection.AutoFilter

   ActiveSheet.Range("$A$1:$L$2500").AutoFilter Field:=3, Criteria1:=X

   '防呆3：無結果

   If Range("A1").End(xlDown).Row = 1048576 Then

       MsgBox "查無資料!!"

       Selection.AutoFilter

       Exit Sub

   End If

   '3.複製

   Range("A1").Select

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

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

   Selection.Copy

   '4.新增工作表

   Sheets.Add After:=Sheets(Sheets.Count)

   Sheets(Sheets.Count).Name = x

   '5.貼上

   Range("A1").Select

   ActiveSheet.Paste

   '6.自動調整欄寬

   Selection.Columns.AutoFit

   Range("A1").Select

   '7.切回原工作表

   Sheets(1).Select

   Application.CutCopyMode = False

   '8.取消篩選

   Selection.AutoFilter

   Range("A1").Select

End Sub

主要是延續HelloWorld按鈕範例，

改為多按鈕，可以顯示在 EditText 中，也可以清除數字，

重點在使用 LinerLayout 來排版 XML檔，

設計好介面之後，再來轉寫程式，以符合MVC的架構，

最後補充多國語系設計，讓不同國家使用者，

都能看到自己區域的語系。

以下有些分享畫面分享：

畫面XML：

1.方向

2.TextView設定

3.按鈕版形

完整教學：

介面：

xmlns:android="http://schemas.android.com/apk/res/android"

   xmlns:tools="http://schemas.android.com/tools"

   android:id="@+id/LinearLayout1"

   android:layout_width="match_parent"

   android:layout_height="match_parent"

   android:orientation="vertical"

   android:paddingBottom="@dimen/activity_vertical_margin"

   android:paddingLeft="@dimen/activity_horizontal_margin"

   android:paddingRight="@dimen/activity_horizontal_margin"

   android:paddingTop="@dimen/activity_vertical_margin"

   tools:context=".MainActivity" >

       android:id="@+id/txtShow"

       android:layout_width="match_parent"

       android:layout_height="wrap_content"

       android:text="電話號碼："

       android:textAppearance="?android:attr/textAppearanceLarge"

       android:textColor="#00FF00"

       android:textSize="30sp" />

       android:layout_width="match_parent"

       android:layout_height="wrap_content"

       android:gravity="center" >        

           android:id="@+id/b01"

           android:layout_width="50dp"

           android:layout_height="wrap_content"

           android:text="1" />

           android:id="@+id/b02"

           android:layout_width="50dp"

           android:layout_height="wrap_content"

           android:text="2" />

           android:id="@+id/b03"

           android:layout_width="50dp"

           android:layout_height="wrap_content"

           android:text="3" />

       android:layout_width="match_parent"

       android:layout_height="wrap_content"

       android:gravity="center" >

           android:id="@+id/b04"

           android:layout_width="50dp"

           android:layout_height="wrap_content"

           android:text="4" />

           android:id="@+id/b05"

           android:layout_width="50dp"

           android:layout_height="wrap_content"

           android:text="5" />

           android:id="@+id/b06"

           android:layout_width="50dp"

           android:layout_height="wrap_content"

           android:text="6" />

       android:layout_width="match_parent"

       android:layout_height="wrap_content"

       android:gravity="center" >

           android:id="@+id/b07"

           android:layout_width="50dp"

           android:layout_height="wrap_content"

           android:text="7" />

           android:id="@+id/b08"

           android:layout_width="50dp"

           android:layout_height="wrap_content"

           android:text="8" />

           android:id="@+id/b09"

           android:layout_width="50dp"

           android:layout_height="wrap_content"

           android:text="9" />

       android:layout_width="match_parent"

       android:layout_height="wrap_content"

       android:gravity="center" >

           android:id="@+id/b10"

           android:layout_width="50dp"

           android:layout_height="wrap_content"

           android:text="*" />

           android:id="@+id/b00"

           android:layout_width="50dp"

           android:layout_height="wrap_content"

           android:text="0" />

           android:id="@+id/b11"

           android:layout_width="50dp"

           android:layout_height="wrap_content"

           android:text="#" />

       android:id="@+id/bClear"

       android:layout_width="150dp"

       android:layout_height="wrap_content"

       android:layout_gravity="center"

       android:text="清除" />

程式設計：

import android.app.Activity;

import android.os.Bundle;

import android.view.View;

import android.widget.Button;

import android.widget.TextView;

public class MainActivity extends Activity {

  //1.宣告物件

  TextView txtShow;

  Button b00,b01,b02,b03,b04,b05,b06,b07,b08,b09,b10,b11,bClear;

  @Override

  protected void onCreate(Bundle savedInstanceState) {

      super.onCreate(savedInstanceState);

      setContentView(R.layout.activity_main);

      //2.連結元件

      txtShow=(TextView) this.findViewById(R.id.txtShow);

      b00=(Button) this.findViewById(R.id.b00);

      b01=(Button) this.findViewById(R.id.b01);

      b02=(Button) this.findViewById(R.id.b02);

      b03=(Button) this.findViewById(R.id.b03);

      b04=(Button) this.findViewById(R.id.b04);

      b05=(Button) this.findViewById(R.id.b05);

      b06=(Button) this.findViewById(R.id.b06);

      b07=(Button) this.findViewById(R.id.b07);

      b08=(Button) this.findViewById(R.id.b08);

      b09=(Button) this.findViewById(R.id.b09);

      b10=(Button) this.findViewById(R.id.b10);

      b11=(Button) this.findViewById(R.id.b11);

      bClear=(Button) this.findViewById(R.id.bClear);

      //3.建立事件

      b00.setOnClickListener(new View.OnClickListener(){

          @Override

          public void onClick(View v) {

              // TODO 自動產生的方法 Stub

              String S=txtShow.getText().toString();

              txtShow.setText(S+"0");

          }});

      b01.setOnClickListener(new Button.OnClickListener(){

          @Override

          public void onClick(View v) {

              // TODO 自動產生的方法 Stub

              String S=txtShow.getText().toString();

              txtShow.setText(S+"1");

          }});

      b02.setOnClickListener(new Button.OnClickListener(){

          @Override

          public void onClick(View v) {

              // TODO 自動產生的方法 Stub

              String S=txtShow.getText().toString();

              txtShow.setText(S+"2");

          }});

      b03.setOnClickListener(new Button.OnClickListener(){

          @Override

          public void onClick(View v) {

              // TODO 自動產生的方法 Stub

              String S=txtShow.getText().toString();

              txtShow.setText(S+"3");

          }});

      b04.setOnClickListener(new Button.OnClickListener(){

          @Override

          public void onClick(View v) {

              // TODO 自動產生的方法 Stub

              String S=txtShow.getText().toString();

              txtShow.setText(S+"4");

          }});

      b05.setOnClickListener(new Button.OnClickListener(){

          @Override

          public void onClick(View v) {

              // TODO 自動產生的方法 Stub

              String S=txtShow.getText().toString();

              txtShow.setText(S+"5");

          }});

      b06.setOnClickListener(new Button.OnClickListener(){

          @Override

          public void onClick(View v) {

              // TODO 自動產生的方法 Stub

              String S=txtShow.getText().toString();

              txtShow.setText(S+"6");

          }});

      b07.setOnClickListener(new Button.OnClickListener(){

          @Override

          public void onClick(View v) {

              // TODO 自動產生的方法 Stub

              String S=txtShow.getText().toString();

              txtShow.setText(S+"7");

          }});

      b08.setOnClickListener(new Button.OnClickListener(){

          @Override

          public void onClick(View v) {

              // TODO 自動產生的方法 Stub

              String S=txtShow.getText().toString();

              txtShow.setText(S+"8");

          }});

      b09.setOnClickListener(new Button.OnClickListener(){

          @Override

          public void onClick(View v) {

              // TODO 自動產生的方法 Stub

              String S=txtShow.getText().toString();

              txtShow.setText(S+"9");

          }});

      b10.setOnClickListener(new Button.OnClickListener(){

          @Override

          public void onClick(View v) {

              // TODO 自動產生的方法 Stub

              String S=txtShow.getText().toString();

              txtShow.setText(S+"*");

          }});

      b11.setOnClickListener(new Button.OnClickListener(){

          @Override

          public void onClick(View v) {

              // TODO 自動產生的方法 Stub

              String S=txtShow.getText().toString();

              txtShow.setText(S+"#");

          }});

      bClear.setOnClickListener(new Button.OnClickListener(){

          @Override

          public void onClick(View v) {

              // TODO 自動產生的方法 Stub

              String S=txtShow.getText().toString();

              if (S.length()>5){

                  txtShow.setText(S.substring(0, S.length()-1));

              }

          }});

  }

}

**補充多國語系設計

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

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

建立資料庫

INSERT INTO 問題1 (姓名,身高,體重,性別,標準體重) values ('楊XX',170,72,'男',69.94)

補充：

查詢資料：select * from 問題1 where 性別='女'

修改資料：Update 問題1 set 身高='170' where 姓名='李XX'

刪除資料：DELETE FROM 問題1 where 姓名='李XX'

如何在EXCEL表單中新增一筆資料到MYSQL資料庫中：

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

   A = Cells(r, 2)

   B = Cells(r, 3)

   C = Cells(r, 4)

   D = Cells(r, 5)

   E = Cells(r, 6)

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

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

End Sub

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

       A = Cells(i, "B")

       B = Cells(i, 3)

       C = Cells(i, 4)

       D = Cells(i, 5)

       E = Cells(i, 6)

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

   Next

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

End Sub

   '1.建立Connection物件

   Set myCon = CreateObject("ADODB.Connection")

   '2.連結資料庫

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

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

   Sql = "INSERT INTO 問題1 (姓名,身高,體重,性別,標準體重) VALUES ('" & _

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

   'MsgBox (Sql)

   Set myRs = myCon.Execute(Sql)

End Sub

Public Sub 刪除EXCEL資料()

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

End Sub

   '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=問題1;User=root;Password=1234;Option=3;"

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

   Sql = "Select * from 問題1"

   'MsgBox (Sql)

   Set myRs = myCon.Execute(Sql)

   Range("B3").CopyFromRecordset myRs

   '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=問題1;User=root;Password=1234;Option=3;"

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

   Sql = "Delete from 問題1"

   'MsgBox (Sql)

   Set myRs = myCon.Execute(Sql)

End Sub

Sub 加框線_實線()

   '指定框線的線條樣式。

   '名稱 值 描述

   'xlContinuous 1 連續線

   'xlDash -4115 虛線

   'xlDashDot 4 交替的虛線與點

   'xlDashDotDot 5 虛線後接兩點

   'xlDot -4118 點狀線

   'xlDouble -4119 雙線

   'xlLineStyleNone -4142 無線條

   'xlSlantDashDot 13 斜虛線

   Range("B3:H13").Borders.LineStyle = xlContinuous

End Sub

Sub 加框線_實線紅色()

   Range("B3:H13").Borders.LineStyle = xlContinuous

   Range("B3:H13").Borders.Color = RGB(255, 0, 0)

End Sub

Sub 加框線_實線紅色粗線()

   '指定範圍外圍框線的粗細。

   '名稱 值 描述

   'xlHairline 1 毫線 (最細的框線)

   'xlMedium -4138 適中

   'xlThick 4 粗線 (最寬的框線)

   'xlThin 2 細線

   Range("B3:H13").Borders.LineStyle = xlContinuous

   Range("B3:H13").Borders.Color = RGB(255, 0, 0)

   Range("B3:H13").Borders.Weight = xlThick

End Sub

Public Sub 清除框線()

   Range("B3:H13").Borders.LineStyle = xlNone

End Sub

Public Function 數字個數函數(原始資料)

   '1.字數迴圈範圍

   For i = 1 To Len(原始資料)

       '2.判斷是否為數字

       If VBA.Asc(Mid(原始資料, i, 1)) > 47 And VBA.Asc(Mid(原始資料, i, 1)) < 58 Then

           '3.如果是就+1

           Count = Count + 1

       End If

   Next

   '4.回傳給自己(數字個數函數)

   數字個數函數 = Count

End Function

   '1.字數迴圈範圍

   For i = 1 To Len(原始資料)

       '2.判斷是否為數字

       If VBA.Asc(Mid(原始資料, i, 1)) <= 47 Or VBA.Asc(Mid(原始資料, i, 1)) >= 58 Then

           '3.如果是就+1

           Count = Count + 1

       End If

   Next

   '4.回傳給自己(數字個數函數)

   非數字個數函數 = Count

End Function

Public Function 留下英文函數(原始資料)

   '初始值

   S = ""

   '1.迴圈到字串長度

   For i = 1 To Len(原始資料)

       '2.判斷數字的編碼範圍

       If VBA.Asc(VBA.UCase(Mid(原始資料, i, 1))) >= 65 And VBA.Asc(VBA.UCase(Mid(原始資料, i, 1))) <= 90 Then

           '3.串接數字

           S = S & Mid(原始資料, i, 1)

       End If

   Next

   '4.輸出結果

   留下英文函數 = S

End Function

   '初始值

   S = ""

   '1.迴圈到字串長度

   For i = 1 To Len(原始資料)

       '2.判斷數字的編碼範圍

       If VBA.Asc(Mid(原始資料, i, 1)) > 127 Or VBA.Asc(Mid(原始資料, i, 1)) < 0 Then

           '3.串接數字

           S = S & Mid(原始資料, i, 1)

       End If

   Next

   '4.輸出結果

   留下中文函數 = S