Excel VBA的封装,加密

对想发布自己的Excel VBA的开发者来说,Excel VBA本身不提供VBA代码的加密,封装。目前比较最可靠的Excel VBA代码加密的方法,就是把VBA代码编译成DLL(动态链接库文件),在VBA中调用,从而实现VBA代码的加密,封装,方便和Excel文件整合发布出去。DLL文件基本没法被破解,除此之外其他的VBA加密方法,都可以被轻易破解。用户只需要你的Excel文件,和这个dll文件就够了,不必安装其他任何程序。
 
编译成DLL文件其实很简单。机子上安装Visual Basic 6.0就可以编译成dll文件了,Visual Basic .Net反倒有点麻烦。Visual Basic通过OLE(对象链接引擎)技术调用Excel以及其中的对象。
 
总的来说,VBA代码只要做一些简单修改就可以了。主要是对Excel对象的引用,不然VB不能识别vba代码中的对象。比如如下的VBA代码
windows(workbook1).activate
range("L50")=1
直接放进VB中编译成Dll就会有问题,因为VB不能直接识别range对象。
需要添加几行简单的代码来告诉vb怎么引用excel中的这些对象:
dim xlapp as excel.applicatiion
dim xlbook as excel.workbook
dim xlsheet as excel.worksheet
set xlapp=getobject(,"excel.application)
set xlbook=getobject(xxx)
set xlsheet=xlbook.worksheets(1)
然后就照搬你原有的vba代码,但是前面加上对象引用:
xlsheet.range("L50")=1
 
对VBA代码做这样修改,在VB中调试通过,就可以成功的把多个sub子程序全部编译封装在一个单独的DLL文件了。以后直接在VBA中引用这个DLL文件中的各个sub子程序。原来大段的VBA代码全部被封装在DLL文件中,对用户不可见。
 
开发者还可以在程序运行前显示软件的版权信息,设置密码。因为这些也封装在DLL文件中,所以用户没法破解。

如何用rc4 加密算法对excel vba进行加密

普通的加密方法太容易破解了,听说用RC4加密,保护比较好,不知道怎么用 

我的意思是对我编的vba程序进行加密,不是加密文件,文件时开放的,谁都可以看。就是不让开代码,平时的加密都是 工具——vbaproject属性——保护 来实现的,这样的加密很脆弱,于是就百度了一番,发现有人推荐RC4加密,但不知怎么实现
***
我就是专门做破解工作的,没有说普通的加密很容易破解,你有密码里加入大小写,特殊符号以及空格,或者在加上几个其它国家的语言文子(比如日文)10位以上,这样就很难破解了,
如果这样不行的话,你用最新版本的RAR(压缩包加密)位数多一点,再加上大小写,特殊符号以及空格或者在加上几个其它国家的语言文字(比如日文)10位以上,目前基本无法破解,破解软件对这种远算只能达到一秒几次。
namespace CryptoRC4
{
    using System;
    using System.Text;

    public class clsRC4Engine
    {
        private static long m_nBoxLen = 255;

        protected clsRC4Engine()
        {

        }
        private static void GetKeyBytes( string Key, out byte[] m_nBox )
        {
            long index2 = 0;
            m_nBox = new byte[m_nBoxLen];
            Encoding ascii      = Encoding.ASCII;
            Encoding unicode    = Encoding.Unicode;
            byte[] asciiBytes = Encoding.Convert(unicode,ascii, unicode.GetBytes( Key ));
           char[] asciiChars = new char[ascii.GetCharCount(asciiBytes,0,asciiBytes.Length)];

            ascii.GetChars(asciiBytes,0,asciiBytes.Length,asciiChars,0);
            long KeyLen = Key.Length;
            for ( long count = 0; count < m_nBoxLen ; count ++ )
            {
                m_nBox[count] = (byte)count;
            }
            for ( long count = 0; count < m_nBoxLen ; count ++ )
            {

                index2 = (index2 + m_nBox[count] + asciiChars[ count % KeyLen ]) % m_nBoxLen;
                byte temp       = m_nBox[count];
                m_nBox[count]   = m_nBox[index2];
                m_nBox[index2]  = temp;
            }
        }

        private static bool GetEncryptBytes( string sData, byte[] m_nBox,out byte[] EncryptedBytes )
        {
            EncryptedBytes = null;
            bool toRet = true;
            try
            {
                long i=0;
                long j=0;
                Encoding enc_default = Encoding.Unicode;
                byte[] input  = enc_default.GetBytes( sData );
                EncryptedBytes = new byte[input.Length];
                byte[] n_LocBox = new byte[m_nBoxLen];
                m_nBox.CopyTo(n_LocBox,0);
                long ChipherLen = input.Length + 1;
                for ( long offset = 0; offset < input.Length ; offset++ )
                {
                    i = ( i + 1 ) % m_nBoxLen;
                    j = ( j + n_LocBox[i] ) %  m_nBoxLen;
                    byte temp =  n_LocBox[i];
                    n_LocBox[i] = n_LocBox[j];
                    n_LocBox[j] = temp;
                    byte a = input[offset];
                    byte b = n_LocBox[(n_LocBox[i]+n_LocBox[j])% m_nBoxLen];
                    EncryptedBytes[offset] = (byte)((int)a^(int)b);
                } 
            }
            catch
            {
                EncryptedBytes = null;

                toRet = false;
            }
            return toRet;
        }

        public static bool Encrypt( string sData, string Key, out string EncryptedString )
        {
            EncryptedString = null;

            if( sData == null || Key == null ) return false;

            byte[] m_nBox;

            GetKeyBytes( Key, out m_nBox );

          

            byte[] output;

            if( GetEncryptBytes( sData, m_nBox, out output ) )

            {

                // Convert data to hex-data

                EncryptedString = "";

                for( int i = 0; i < output.Length; i++ )

                    EncryptedString += output[i].ToString( "X2" );



                return true;

            }

            else

                return false;
        }



        /// <summary>

        /// Decrypt data using specific key

        /// </summary>

        /// <param name="EncryptedString"></param>

        /// <param name="Key"></param>

        /// <param name="sData"></param>

        /// <returns></returns>

        public static bool Decrypt( string EncryptedString, string Key, out string sData )

        {

            sData = null;

            if( EncryptedString == null || Key == null ) return false;

            else if( EncryptedString.Length % 2 != 0 ) return false;

            byte[] m_nBox;

            GetKeyBytes( Key, out m_nBox );



            // Convert data from hex-data to string

            byte[] bData = new byte[EncryptedString.Length / 2];

            for( int i = 0; i < bData.Length; i++ )

                bData[i] = Convert.ToByte( EncryptedString.Substring( i * 2, 2 ), 16 );



            EncryptedString = Encoding.Unicode.GetString( bData );

          

            byte[] output;

            if( GetEncryptBytes( EncryptedString, m_nBox, out output ) )

            {

                sData = Encoding.Unicode.GetString( output );

                return true;

            }

            else

                return false;

        }

    }

}



调用:

    //Encrypt data

    string strEncryptedString;

    if( clsRC4Engine.Encrypt( strValue, strKey, out strEncryptedString ) )

         MessageBox.Show( strEncryptedString );



    //Decrypt data

    string strDecryptedString;

    if( clsRC4Engine.Decrypt( strValue, strKey, out strDecryptedString ) )

         MessageBox.Show( strDecryptedString );

另外一种
       public static string encrypt_str( string str )
        {
            string s = "";
            int i_Encrypt = ClsSetConst.m_Set_Encrypt;
            char[] s_array = str.ToCharArray();
            for(int i = 0; i < s_array.Length; i++)
            {
                int x = ((int)s_array[i]) + i_Encrypt;
                s += (char)(x);
            }
            return s;
        }
        public void decript_str(string str)
        {
            string s = "";
            int i_Encrypt = ClsSetConst.m_Set_Encrypt;
            char[] s_array = str.ToCharArray();
            for(int i = 0; i < s_array.Length; i++)
            {
                int x = ((int)s_array[i]) - i_Encrypt;
                s += (char)x;
            }
自己看看有没有输错的地方吧

设计一个简单的加密程序,它把当前的字母变成下个字母。例如:a变成b......把z变成a,但其他字符不变。

#include<stdio.h>
  char[] c = "";//要加密的字符串
  
  for(int i = 0; i < c.length; i++) {
   if(c[i] == 'z') {
    c[i] = 'a';
   }else if(c[i] == 'Z') {
    c[i] = 'A';
   }else {
    c[i] += 1;
   }
  }
  
 //然后输出数组c,忘记c++怎么输出了

编写一个简单的字符加密程序,该加密算法将A→d,B→e,C→f,…, W→z,X→a,Y→b

编写一个简单的字符加密程序,该加密算法将A→d,B→e,C→f,…, W→z,X→a,Y→b,Z→c,要求输入任意一个大写字符,由程序将加密后的小写字符输出.谢谢啊
问题补充:
我们刚学C,难的比如IF语句都不让用的....大家得用简单的语句解决他...答对另外有赏~~~
*****
main()
{ char i,t;
scanf("%c",&i);
t='a'+(i-'a'+3)%26+32;//important point
printf("%c",t);
}
******

excel vba工程密码加密和破解

  1. '0>注意保护版权,仅供学习使用。   
  2.   
  3. '1>一段极好的VBA保护密码破解程序测试WIN98+OFFICE97破解率100%   
  4.   
  5. '2>用以下代码对VBA加密保护后用offkey 6.5-7.0及Advanced VBA pASSWORD Recovery专业版均无法破解出保护程式码的密码   
  6.   
  7. '移除VBA编码保护   
  8.   
  9. Sub MoveProtect()   
  10.   
  11. Dim FileName As String   
  12.   
  13. FileName = Application.GetOpenFilename("Excel文件(*.xls & *.xla),*.xls;*.xla", , "VBA破解")   
  14.   
  15. If FileName = CStr(False) Then   
  16.   
  17.      Exit Sub   
  18.   
  19. Else   
  20.   
  21.      VBAPassword FileName, False   
  22.   
  23. End If   
  24.   
  25. End Sub   
  26.   
  27. '设置VBA编码保护   
  28.   
  29. Sub SetProtect()   
  30.   
  31. Dim FileName As String   
  32.   
  33. FileName = Application.GetOpenFilename("Excel文件(*.xls & *.xla),*.xls;*.xla", , "VBA破解")   
  34.   
  35. If FileName = CStr(False) Then   
  36.   
  37.      Exit Sub   
  38.   
  39. Else   
  40.   
  41.      VBAPassword FileName, True   
  42.   
  43. End If   
  44.   
  45. End Sub   
  46.   
  47. Private Function VBAPassword(FileName As String, Optional Protect As Boolean = False)   
  48.   
  49.     If Dir(FileName) = "" Then   
  50.   
  51.        Exit Function   
  52.   
  53.     Else   
  54.   
  55.        FileCopy FileName, FileName & ".bak"  
  56.   
  57.     End If   
  58.   
  59.     Dim GetData As String * 5   
  60.   
  61.     Open FileName For Binary As #1   
  62.   
  63.     Dim CMGs As Long   
  64.   
  65.     Dim DPBo As Long   
  66.   
  67.     For i = 1 To LOF(1)   
  68.   
  69.         Get #1, i, GetData   
  70.   
  71.         If GetData = "CMG=""" Then CMGs = i   
  72.   
  73.         If GetData = "[Host" Then DPBo = i - 2: Exit For   
  74.   
  75.     Next   
  76.   
  77.        
  78.   
  79.     If CMGs = 0 Then   
  80.   
  81.        MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"  
  82.   
  83.        Exit Function   
  84.   
  85.     End If   
  86.   
  87.        
  88.   
  89.     If Protect = False Then   
  90.   
  91.        Dim St As String * 2   
  92.   
  93.        Dim s20 As String * 1   
  94.   
  95.           
  96.   
  97.        '取得一个0D0A十六进制字串   
  98.   
  99.        Get #1, CMGs - 2, St   
  100.   
  101.        
  102.   
  103.        '取得一个20十六制字串   
  104.   
  105.        Get #1, DPBo + 16, s20   
  106.   
  107.        
  108.   
  109.        '替换加密部份机码   
  110.   
  111.        For i = CMGs To DPBo Step 2   
  112.   
  113.            Put #1, i, St   
  114.   
  115.        Next   
  116.   
  117.           
  118.   
  119.        '加入不配对符号   
  120.   
  121.        If (DPBo - CMGs) Mod 2 <> 0 Then   
  122.   
  123.           Put #1, DPBo + 1, s20   
  124.   
  125.        End If   
  126.   
  127.        MsgBox "文件解密成功......", 32, "提示"  
  128.   
  129.     Else   
  130.   
  131.        Dim MMs As String * 5   
  132.   
  133.        MMs = "DPB="""  
  134.   
  135.        Put #1, CMGs, MMs   
  136.   
  137.        MsgBox "对文件特殊加密成功......", 32, "提示"  
  138.   
  139.     End If   
  140.   
  141.     Close #1   
  142.   
  143. End Function  

將橫列的資料轉為直列-用TRANSPOSE公式

TRANSPOSE(array)
現有資料在A1:D1,分別為TEST1, TEST2, TEST3, TEST4
要將此四個資料分別轉置到A3,A4,A5,A6中,

1.  一次過選取欲要放置資料的位置A3:A6
2.  輸入 =TRANSPOSE(A1:D1)
3.  按 Crtl+Shift+Enter (因為 Transpose 是一條 Array Formula)
4.  再將A3:A6公式轉回值便可以。

2 WAYS LOOKUP

<<摘自PAN網誌>>
vlookup 和 hlookup, 這都是單向的lookup, 如要做到雙向lookup,便要利用index() 和 match()公式:-
先以index()公式去lookup 正確的位置,如我們想找 PETER + SCB的值($10,000)

INDEX(array,row_num,column_num)       即 =INDEX(C5:F9,C11,C12)
Array  -  C5:F9
Rom_num  -  PETER: 3 (第三行)
Column_num  -  SCB: 2 (第二個 column)
如何可以知道peter 和 scb 是在第幾row和column呢?借助match()公式便可以得到其正確位置(Row and Column)
MATCH(lookup_value,lookup_array,match_type)
For Row:      如 D11 =match(A11,A5:A9,0)
Lookup_Value = Peter
lookup_array = A5:A9
match_type = 0 (exact match)
For Column:     如 D12 =match(A12,C3:F3,0)
Lookup_Value = SCB
lookup_array = C3:F3
match_type = 0 (exact match)
通過match(),我們便得到 PETER  和 SCB 的傳回value (3 and 2)
最後2ways lookup 的 formula 是這樣的:
=INDEX(C5:F9,MATCH(A11,A5:A9,0),MATCH(A12,C3:F3,0))

以下為VBA FUNCTION:-

Function TwoWayLookup(Data_area, Row_value, Row_area, Column_value, Column_area)
    hello_row = Application.WorksheetFunction.Match(Row_value, Row_area, 0)
   
    hello_column = Application.WorksheetFunction.Match(Column_value, Column_area, 0)
    hello = Application.WorksheetFunction.Index(Data_area, hello_row, hello_column)
    TwoWayLookup = hello

End Function

每一查詢資料輸入後便立即進行對比而即時得到結果

在指定的工作表(例如:"輸入"工作表)中指定位置(例如E7及其之下)輸入查詢資料,
每輸入一筆資料,便觸動程式立即以指定資料儲存工作表(例如:"DATA"工作表)中
指定位置範圍的內容進行對比,一旦發現在"DATA"工作表中沒有對應資料,便會
在"輸入"工作表中顯示結果的位置(例如:B7及其以下)顯示出一個紅色的問號(?)。

程式如下(必須放在"輸入"工作表"中):
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Row < 7 Then Exit Sub
    If Target.Column <> 5 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    If Sheets("DATA").[b:b].Find(Target, , , 1) Is Nothing Then
        Target.Offset(, -3) = "?"
        Target.Offset(, -3).Font.ColorIndex = 3
        Else
        Target.Offset(, -3) = ""
        Target.Offset(, -3).Font.ColorIndex = 0
     End If
     Application.EnableEvents = True
End Sub

附註:

因為所執行的動作是:當有資料寫入儲存格後才要判斷執行任務,所以要 寫在Worksheet_Change事件中。
而Worksheet_SelectionChange是在點擊儲存格就發生的事件。

以B macro執行A macro

 我在檔案 a.xlsm 中 a-sheet 已建立一個 vba macro 為 a-macro,
       1. 當我在另一個檔案 b.xlsm 中的 b-macro 中要使用到 a.xlsm 中的 a-macro 時要如何開啟, 執行及關閉?
       2. 若我已經將 a-macro 由 a.xlsm 中匯出成一個 a.bas 檔案時, 我如何由 b-macro 呼叫開啟, 執行及關閉?
程式如下:-
  1. Sub bb()
  2. Workbooks.Open "E:\aa.xls" '開啟活頁簿
  3. Application.Run "aa.xls!aaa" '執行巨集
  4. End Sub
  5. Sub kk()
  6. With ActiveWorkbook.VBProject.VBComponents.Import("E:\a.bas") '匯入
  7. Application.Run "aaa" '執行
  8. Application.VBE.ActiveVBProject.VBComponents.Remove Application.VBE.ActiveVBProject.VBComponents(.Name) '刪除
  9. End With
  10. End Sub
**********
對於H大 sub kk()有點問題
我照一次辦
但compiler說remove那行引數不為選擇性(not optional)
停了macro
*********
有點問題,這是3樓H大的程式,加少少修改
有兩個excel file,一名為a.xls,內有一個叫sub a()的程式,執行一個簡單的msgbox訊息,我把它匯出至a.bas,打算由b.xls中的sub c()叫出該a.bas,可是程式壞了. 不知如何是好
********
  1. Sub c()
  2. With ActiveWorkbook.VBProject.VBComponents.Import("D:\Tony\Excel VBA\a.bas")
  3. Application.Run "a"
  4. Application.VBE.ActiveVBProject.VBComponents.Remove _
  5. Application.VBE.ActiveVBProject.VBComponents(.Name)
  6. End With
  7. End Sub
*************

學習Excel VBA的一些基本概念

<<摘自麻辣家族討論版 >>

為了學習Excel中的巨集,我們需要先瞭解以下一些基本概念
1、工作簿:Workbooks、Workbook、ActiveWorkbook、ThisWorkbook
  Workbooks集合包含Excel中所有當前打開的Excel工作簿,亦即所有打開的Excel文件;Workbook對應Workbooks中的成員,即其中的Excel檔;ActiveWorkbook代表當前處於活動狀態的工作簿,即當前顯示的Excel檔;ThisWorkbook代表其中有Visual Basic代碼正在運行的工作簿。
  在具體使用中可用Workbooks(index)來引用Workbook物件,其中index為工作簿名稱或編號;如Workbooks(1)、Workbooks("年度報表.xls")。而編號按照創建或打開工作簿的順序來確定,第一個打開的工作簿編號為1,第二個打開的工作簿為2……。

2、工作表:Worksheets、Worksheet、ActiveSheet
  Worksheets集合包含工作簿中所有的工作表,即一個Excel檔中的所有資料表頁;而Worksheet則代表其中的一個工作表;ActiveSheet代表當前處於的活動狀態工作表,即當前顯示的一個工作表。
  可用Worksheets(index)來引用Worksheet物件,其中index為工作表名稱或索引號;如Worksheets(1)、Worksheets("第一季度資料")。工作表索引號表明該工作表在工作表標籤中的位置:第一個(最左邊的)工作表的索引號為1,最後一個(最右邊的)為Worksheets.Count。需要注意的是:在使用過程中Excel會自動重排工作表索引號,保持按照其在工作表標籤中的從左至右排列,工作表的索引號遞增。因此,由於可能進行的工作表添加或刪除,工作表索引號不一定始終保持不變。  

3、圖表:Chart 、Charts、ChartObject、ChartObjects、ActiveChart
  Chart代表工作簿中的圖表。該圖表既可為嵌入式圖表(包含在ChartObject中),也可為一個分開的(單獨的)圖表工作表。
  Charts代表指定工作簿或活動工作簿中所有圖表工作表的集合,但不包括嵌入式在工作表或對話方塊編輯表中的圖表。使用Charts(index) 可引用單個Chart圖表,其中index是該圖表工作表的索引號或名稱;如Charts(1)、Charts("銷售圖表")。圖表工作表的索引號表示圖表工作表在工作簿的工作表標籤欄上的位置。Charts(1)是工作簿中第一個(最左邊的)圖表工作表;Charts(Charts.Count)為最後一個(最右邊的)圖表工作表。
  ChartObject代表工作表中的嵌入式圖表,其作用是作為Chart對象的容器。利用ChartObject可以控制工作表上嵌入式圖表的外觀和尺寸。
  ChartObjects代表指定的圖表工作表、對話方塊編輯表或工作表上所有嵌入式圖表的集合。可由ChartObjects(index)引用單個ChartObject,其中index為嵌入式圖表的編號或名稱。如Worksheets("Sheet1").ChartObjects(1)、Worksheets("sheet1").ChartObjects("chart1")分別對應"Sheet1"工作表中的第一個嵌入式圖表、以及名為"Chart1"的嵌入式圖表。
  ActiveChart可以引用活動狀態下的圖表,不論該圖表是圖表工作表,或嵌入式圖表。而對於圖表工作表為活動工作表時,還可以通過ActiveSheet屬性引用之。

4、單格:Cells、ActiveCell、Range、Areas
  Cells(row,column)代表單個單格,其中row為行號,column為列號。如可以用Cells(1,1)、Cells(10,4)來引用"A1"、"D10" 單格。ActiveCell代表活動工作表的活動單格,或指定工作表的活動單格。
  Range代表工作表中的某一單格、某一行、某一列、某一選定區域(該選定區域可包含一個或若干連續單格區域)或者某一三維區域。
  可用Range(arg)來引用單格或單格區域,其中arg可為單格號、單格號範圍、單格區域名稱。如Range("A5")、Range("A1:H8")、Range("Criteria")。雖然可用Range("A1")返回單格A1,但用Cells更方便,因為此時可用變數指定行和列。
 可將Range與Cells結合起來使用,如Range(Cells(1,1),Cells(10,10))代表單格區域"A1:J10";而expression.Cells(row,column)返回單格區域中的一部分,其中expression是返回Range的運算式,row和column為相對於該區域的左上角偏移量。如由Range("C5:C10").Cells(1,1)引用單格C5。
  Areas為選定區域內的連續單格塊的集合,其成員是Range對象。而其中的每個Range物件代表選定區域內與其他部分相分離的一個連續單格塊。某些操作不能在選定區域內的多個單格塊上同時執行;必須在選定區域內的單格塊數Areas.Count上迴圈,對每個單獨的單格塊分別執行該操作。此時,可用Areas(index)從集合中返回單個Range物件,其中index為單格塊編號;如Areas(1)。

5、 行與列:Rows、Columns、Row、Column
  Rows、Columns分別代表活動工作表、單格區域範圍Range、指定工作表中的所有行數、列數。對於一個多選單格區域範圍Range的Rows、Columns,只返回該範圍中第一個區域的行數、列數。例如,如果Range物件有兩個區域(areas)A1:B2和C3:D4,Rows.Count返回2而不是4。
  可通過Rows(行號)、Columns(列號)來引用相應的行與列;如Rows(3)、Columns(4)分別對應第三行、D列。
利用Rows、Column可以獲得區域中第一塊的第一行行號、第一列列號,所得值均以十進位數字表示。

VBA的寫作技巧與增進效能

VBA的寫作技巧與增進效能
[轉貼自麻辣家族討論版版]

經由錄製產生的巨集,通常程式碼都會含有很多 Select,甚至往後自己寫的程式也習慣用一堆 Select。寫程式的人以為必須 Select 一個物件後才能對它做處理,但這是 [錄製巨集] 誤導的錯誤觀念 (自己也沒有徹底了解語法),而且是造成巨集執行效率不佳的原因之一。

一、數數看你的程式裡有多少 "Select" ?
除非程式就是要依使用者選取的物件來做動作,否則 Select 和 Selection 都是多餘的.
◎ 標準的物件控制語法:
  物件.方法 (例如 Range("A1").Copy)
  物件.屬性 = 值 (例如 Range("A1").ColorIndex = 15)
而不是一定要先 Select 物件然後再對 Selection 做動作.

舉例而言,你要複製 Sheet1.A1 的值到 Sheet2.B1 --
 Range("A1").Copy
 Sheets(2).Select
 Range("B1").Select
 Range("B1").PasteSpecial xlPasteValues
其實可以這麼寫 --
 Sheets(2).Range("B1") = Sheets(1).Range("A1")
如果內容與格式都要複製,可以這麼寫 --
 Sheets(1).Range("A1").Copy Sheets(2).Range("B1")

不要看這沒什麼,你的VBA觀念和程度能否更進一步,這是很重要的一點。

二、關閉螢幕更新 (Application.ScreenUpdating)
程式裡做的動作越多,螢幕更新的問題就越明顯。例如選取了儲存格、選取物件、複製、貼上、切換工作表... Excel 都會改變焦點 (Focus). 每改變一次,就是一次螢幕更新。想想看,在一連串的螢幕更新之中,不但令使用者眼花撩亂,程式執行的整體效能也會下降。

這與減少 Select 是一體兩面的事,其實很多選取儲存格、選取物件、複製、貼上、切換工作表... 的動作都是不必要的。只要技巧用的好,ScreenUpdating 幾乎可以束之高閣。

三、過多/不必要的迴圈也會降低執行效率
迴圈 (如 For...Next、Do...Loop等等) 是很重要的寫作技巧之一,它能大幅簡化程式中重複的動作,而且是錄製不出來的。
這裡所謂不必要的迴圈是指處理的範圍太大,浪費過多時間。例如
For Each cell In Columns(1)
 ......
Next
For Each cell In [A1:A65536]
 ......
Next
以上兩個迴圈都是處理 A 欄 6 萬多個儲存格。
說實在的,連幾千個Cell我都有點擔心了,何況幾萬個 -- 有必要嗎??
何不判斷好資料的範圍再來做迴圈 --
For Each cell In Range([A1], [A65536].End(xlUp))
 ......
Next

參考: 如何判斷資料範圍
http://gb.twbts.com/index.php/topic,315.0.html
http://gb.twbts.com/index.php/topic,584.0.html

四、釋放物件變數佔用的記憶體空間
在這裡尤指對應用程式(Appliation)的引用與存取,下例從Word表格取回資料至Excel工作表 --

Sub get_word_table( )
Dim wrdApp As Object
Set wrdApp = CreateObject("Word.Application") '建立引用Word應用程式的物件
Set wrdDoc = wrdApp.Documents.Open("D:\Temp\ole_test.doc") '引用Word文件
With wrdDoc.Tables(1)
 For r = 1 To .Rows.Count
  For c = 1 To .Columns.Count
  Cells(r, c) = .Cell(r, c)
  Next c
 Next r
End With
wrdDoc.Close 'close the document
wrdApp.Quit 'close Word
Set wrdDoc = Nothing '釋放物件變數
Set wrdApp = Nothing
End Sub

初學者常常會忽略最後兩句,如果不寫雖然不會影響程式的運行,但從記憶體管理和效能控制的角度而言,這是個很不好的習慣。

當省則省,省的是多餘重複的程式碼;
當用則用,用的是不可或缺的程式碼。

有用網站集合區

台灣無名小站 - http://www.wretch.cc/blog/
Googles - http://www.blogger.com/
Excel VBA and others - http://vba.blogspot.com/
 麻辣家族討論版 - http://forum.twbts.com/
OFFICE精英俱乐部 - http://www.officefans.net/cdb/index.php
Excel技巧網 - http://www.exceltip.net/
Excel Home  - http://club.excelhome.net/forum.php
銳普PPT - http://www.rapidbbs.cn/

破解Excel 保護工作表 的密碼

破解Excel 保護工作表 的密碼

以下VBA可以查出[保護工作表]的密碼.
此為4位數的[英數密碼], 可自行修改以符合自己的需求.
Sub JackyCP()
Dim DimArr(63)
Dim PW As String
For x = 48 To 57
xx = xx + 1
DimArr(xx) = Chr(x)
Next
For x = 97 To 122
xx = xx + 1
DimArr(xx) = Chr(x)
NextFor x = 65 To 90
xx = xx + 1
DimArr(xx) = Chr(x)Next
On Error Resume Next

For x1 = 1 To UBound(DimArr) - 1
For x2 = 1 To UBound(DimArr) - 1
For x3 = 1 To UBound(DimArr) - 1
For x4 = 1 To UBound(DimArr) - 1
PW = DimArr(x1) & DimArr(x2) & DimArr(x3) & DimArr(x4)
Application.StatusBar = PW
ActiveSheet.Unprotect PW
If ActiveSheet.ProtectContents = False Then
MsgBox "Password is " & PW
Exit Sub
End If
Next
Next
Next
Next
End Sub