以下為自動新增指定名稱及數量的空白工作表巨集：
Sub add_sheet()
Dim shtnr As Integer
Dim shtname As String
shtnr = InputBox("請輸入新增工作表數量: ")
shtname = InputBox("請輸入新增工作表的前綴名稱: ")
For i = 1 To shtnr
Worksheets.Add
ActiveSheet.Name = shtname & "-" & i
Next
End Sub
解除EXCLE保護工作表儲存格的巨集程式
解除EXCLE保護工作表儲存格的巨集程式
此乃網路上有看到的Excel 2007工作表密碼保護的解除方法
VBA巨集程式破解法：
Sub PasswordBreaker()
Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer
On Error Resume Next
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If ActiveSheet.ProtectContents = False Then
MsgBox "One usable password is " & Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
ActiveWorkbook.Sheets(1).Select
Range("a1").FormulaR1C1 = Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
Exit Sub
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
End Sub
若要破解整個活頁簿保護密碼，則需要使用另一個 Excel 活頁簿密碼破解工具，找到後再放上來。
此乃網路上有看到的Excel 2007工作表密碼保護的解除方法
VBA巨集程式破解法：
Sub PasswordBreaker()
Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer
On Error Resume Next
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If ActiveSheet.ProtectContents = False Then
MsgBox "One usable password is " & Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
ActiveWorkbook.Sheets(1).Select
Range("a1").FormulaR1C1 = Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
Exit Sub
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
End Sub
若要破解整個活頁簿保護密碼，則需要使用另一個 Excel 活頁簿密碼破解工具，找到後再放上來。
以K為主，C為第二選擇順序排列好，然後再參考K的名稱，將K中每一類別的單號分類合併在各M行中, 以","作為分隔。
以K為主，C為第二選擇順序排列好，然後再參考K的名稱，將K中每一類別的單號分類合併在各M行中, 以","作為分隔。
Sub combinelotno()
Set d = CreateObject("Scripting.Dictionary")
For Each a In Range([K2], [K2].End(xlDown))
If d(a.Value) = "" Then
d(a.Value) = a.Offset(, -8)
Else
d(a.Value) = d(a.Value) & "," & a.Offset(, -8)
End If
Next
[L:N] = ""
[L2].Resize(d.Count, 1) = Application.Transpose(d.keys)
[M2].Resize(d.Count, 1) = Application.Transpose(d.items)
End Sub
Sub combinelotno()
Set d = CreateObject("Scripting.Dictionary")
For Each a In Range([K2], [K2].End(xlDown))
If d(a.Value) = "" Then
d(a.Value) = a.Offset(, -8)
Else
d(a.Value) = d(a.Value) & "," & a.Offset(, -8)
End If
Next
[L:N] = ""
[L2].Resize(d.Count, 1) = Application.Transpose(d.keys)
[M2].Resize(d.Count, 1) = Application.Transpose(d.items)
End Sub
Search file and data between several workbooks using Excel Macros
我有幾個file.file名不同.怎樣寫個macro可對應相關檔案同關鍵字找查資料.
例如, 我想用第一個file叫trade,內面有以下資料:
sku_alias Qty Supplier NamePO Date
256-10009-014,200 HANG 31015775
ACC-001-0415300HANG 31015888
ACC-001-0411500WAI 31015888
另外有兩個files, 分別是supplier hang，有以下資料:
例如, 我想用第一個file叫trade,內面有以下資料:
sku_alias Qty Supplier NamePO Date
256-10009-014,200 HANG 31015775
ACC-001-0415300HANG 31015888
ACC-001-0411500WAI 31015888
另外有兩個files, 分別是supplier hang，有以下資料:
sku_alias Qty Supplier NamePO Date
256-10009-014,200 HANG 31015775 8/7/10
ACC-001-0415300HANG 31015888 9/7/10
及 supplier wai, 其內存資料如下:
sku_alias Qty Supplier NamePO Date
ACC-001-0411500WAI 31015888 10/7/10
在trade的file中, 如何寫可以對照其supplier name查找相關的supplier file, 取用file中的日期?
256-10009-014,200 HANG 31015775 8/7/10
ACC-001-0415300HANG 31015888 9/7/10
及 supplier wai, 其內存資料如下:
sku_alias Qty Supplier NamePO Date
ACC-001-0411500WAI 31015888 10/7/10
在trade的file中, 如何寫可以對照其supplier name查找相關的supplier file, 取用file中的日期?
答案：
簡單寫了段MACRO, 祇應付問題要求
Sub marco1()
Set bk1 = Workbooks("hang").Sheets("Sheet1").Range("A2:A100")
Set bk2 = Workbooks("wai").Sheets("Sheet1").Range("A2:A100")
For Each cell In Range("a2:a100")
If IsEmpty(cell) = True Then Exit Sub
Select Case cell.Offset(0, 2)
Case "HANG"
Set bk = bk1
Case "WAI"
Set bk = bk2
End Select
For Each c1 In bk
If c1 = cell And c1.Offset(0, 1) = cell.Offset(0, 1) And_
c1.Offset(0, 3) = cell.Offset(0, 3) Then
cell.Offset(0, 4) = c1.Offset(0, 4)
Exit For
End If
Next
Next
End Sub
Sub marco1()
Set bk1 = Workbooks("hang").Sheets("Sheet1").Range("A2:A100")
Set bk2 = Workbooks("wai").Sheets("Sheet1").Range("A2:A100")
For Each cell In Range("a2:a100")
If IsEmpty(cell) = True Then Exit Sub
Select Case cell.Offset(0, 2)
Case "HANG"
Set bk = bk1
Case "WAI"
Set bk = bk2
End Select
For Each c1 In bk
If c1 = cell And c1.Offset(0, 1) = cell.Offset(0, 1) And_
c1.Offset(0, 3) = cell.Offset(0, 3) Then
cell.Offset(0, 4) = c1.Offset(0, 4)
Exit For
End If
Next
Next
End Sub
如何一次過找尋/查詢數份WORKSHEET內容?
在一個excel檔中有幾份worksheet, 怎樣可以一次過keyword search 幾頁worksheet 呢？
Step1: 按住Keyboard的(Ctrl)不放然後點選所有要搜索的Worksheet
Step2: 同時按Keyboard的(Ctrl+F)
Step3: 於跳出的“尋找”視窗輸入Keyword就可以了
Step2: 同時按Keyboard的(Ctrl+F)
Step3: 於跳出的“尋找”視窗輸入Keyword就可以了
如何讓今日之前 儲存格 不能修改 刪除 也不能插入列
Private Sub Workbook_Open()
'請將程式碼複製到 :VBA視窗的ThisWorkbook中,存檔後重新開檔便可
Dim 密碼 As String, Sh As Worksheet
密碼 = "1234"
Set Sh = ActiveSheet '作用中的工作表
'Set Sh = Sheet1 'VBA 物件名稱
'Set Sh = Sheets("測試工作表") '活頁簿工作表名稱
'Set Sh = Sheets(2) '活頁簿工作表的排序
With ThisWorkbook 'ThisWorkbook -> VBA 的活頁簿物件
.Names.Add "日期", Date - 1, False '活頁簿定義名稱, False->隱藏
'執行一次後請在前面加上註解 " ' " 或 刪除 停止此程式碼執行
If Val(Replace(.Names("日期"), "=", "")) <> Date Then '不是今日
.Names("日期").Value = Date '修改Value為今日
.Names.Add "MyRange", Sh.UsedRange ', False '定義名稱"MyRange" 範圍指定為 ActiveSheet.UsedRange
'.Names.Add "MyRange", Sh.UsedRange , False 'False->定義名稱隱藏
With Sh '指定的工作表
.Unprotect 密碼 '取消工作表保護
.Cells.Locked = False '取消儲存格鎖定->工作表的Cells
.Cells.FormulaHidden = False '取消儲存格隱藏->工作表的Cells
Range("MyRange").Locked = True '儲存格鎖定-> "MyRange"的範圍
Range("MyRange").FormulaHidden = True '儲存格隱藏-> "MyRange"的範圍
.Protect 密碼 '工作表設定保護
End With
End If
End With
End Sub
'請將程式碼複製到 :VBA視窗的ThisWorkbook中,存檔後重新開檔便可
Dim 密碼 As String, Sh As Worksheet
密碼 = "1234"
Set Sh = ActiveSheet '作用中的工作表
'Set Sh = Sheet1 'VBA 物件名稱
'Set Sh = Sheets("測試工作表") '活頁簿工作表名稱
'Set Sh = Sheets(2) '活頁簿工作表的排序
With ThisWorkbook 'ThisWorkbook -> VBA 的活頁簿物件
.Names.Add "日期", Date - 1, False '活頁簿定義名稱, False->隱藏
'執行一次後請在前面加上註解 " ' " 或 刪除 停止此程式碼執行
If Val(Replace(.Names("日期"), "=", "")) <> Date Then '不是今日
.Names("日期").Value = Date '修改Value為今日
.Names.Add "MyRange", Sh.UsedRange ', False '定義名稱"MyRange" 範圍指定為 ActiveSheet.UsedRange
'.Names.Add "MyRange", Sh.UsedRange , False 'False->定義名稱隱藏
With Sh '指定的工作表
.Unprotect 密碼 '取消工作表保護
.Cells.Locked = False '取消儲存格鎖定->工作表的Cells
.Cells.FormulaHidden = False '取消儲存格隱藏->工作表的Cells
Range("MyRange").Locked = True '儲存格鎖定-> "MyRange"的範圍
Range("MyRange").FormulaHidden = True '儲存格隱藏-> "MyRange"的範圍
.Protect 密碼 '工作表設定保護
End With
End If
End With
End Sub
透過vba在文字檔案搜尋某一字串,再將包含此字串的整列data import至excel工作表
透過vba在文字檔案搜尋某一字串,再將包含此字串的整列data import至excel工作表
Sub 匯入文字檔A()
Dim i As Integer, ii As Integer, Str As Variant, F As Object
With Application.FileDialog(msoFileDialogFilePicker) '[檔案選擇器]
.AllowMultiSelect = True '可多重選擇檔案
.Title = "文字檔 匯入excel" '[檔案選擇器] 的標題
.Filters.Clear '清除 [檔案選擇器] 對話方塊的檔案篩選
.Filters.Add "文字檔", "*.txt", 1 '新增 [檔案選擇器] 對話方塊的檔案篩選
'篩選清單中新控制項所在位置的數值 1
.Filters.Add "*.*", "*.*", 2 '新增 [檔案選擇器] 對話方塊的檔案篩選
'篩選清單中新控制項所在位置的數值 2
.FilterIndex = 1 '當檔案對話方塊首次開啟時，預設篩選判定所顯示的檔案類型。
If .Show = 0 Then Exit Sub '沒選擇檔案時離開檔案
For i = 1 To .SelectedItems.Count '依序在選擇檔案數目的迴圈
Set F = CreateObject("Scripting.FileSystemObject").OpenTextFile(.SelectedItems(i), 1, -1)
'F.READALL 讀取檔案的文字, Split(字串, 分隔字串)->傳回一維陣列
For Each Str In Split(F.READALL, Chr(10)) '傳回一維陣列 的迴圈
If Str Like "*TEST*" Then
Cells(ii + 1, "a") = Str '整列匯入工作表
ii = ii + 1 '下一列
End If
Next
F.Close '關閉文字檔
Next
End With
End Sub
Sub 匯入文字檔A()
Dim i As Integer, ii As Integer, Str As Variant, F As Object
With Application.FileDialog(msoFileDialogFilePicker) '[檔案選擇器]
.AllowMultiSelect = True '可多重選擇檔案
.Title = "文字檔 匯入excel" '[檔案選擇器] 的標題
.Filters.Clear '清除 [檔案選擇器] 對話方塊的檔案篩選
.Filters.Add "文字檔", "*.txt", 1 '新增 [檔案選擇器] 對話方塊的檔案篩選
'篩選清單中新控制項所在位置的數值 1
.Filters.Add "*.*", "*.*", 2 '新增 [檔案選擇器] 對話方塊的檔案篩選
'篩選清單中新控制項所在位置的數值 2
.FilterIndex = 1 '當檔案對話方塊首次開啟時，預設篩選判定所顯示的檔案類型。
If .Show = 0 Then Exit Sub '沒選擇檔案時離開檔案
For i = 1 To .SelectedItems.Count '依序在選擇檔案數目的迴圈
Set F = CreateObject("Scripting.FileSystemObject").OpenTextFile(.SelectedItems(i), 1, -1)
'F.READALL 讀取檔案的文字, Split(字串, 分隔字串)->傳回一維陣列
For Each Str In Split(F.READALL, Chr(10)) '傳回一維陣列 的迴圈
If Str Like "*TEST*" Then
Cells(ii + 1, "a") = Str '整列匯入工作表
ii = ii + 1 '下一列
End If
Next
F.Close '關閉文字檔
Next
End With
End Sub
Excel欄位的選擇技巧
今天就來分享一下Excel欄位的選擇技巧！
方法：
一、將儲存格移動到欄或列的最前方或最後方。
01.垂直移動到最頂端，按下Ctrl+↑上箭頭鍵。
垂直移動到最底端，按下Ctrl+↓下箭頭鍵。
平行移動到最前端，按下Ctrl+←左鍵頭鍵。
平行移動到最後端，按下Ctrl+→右箭頭鍵。
02.除了利用鍵盤可以控制，那滑鼠可以嗎？答案是可以的。只要你點選儲存格黑框的四邊兩次，如黑框下方滑鼠左鍵快擊兩下。
03.選取框便會自動跳至最底端。
二、加上Shift鍵達到連續格選取功能。
我們知道按住Shift鍵可在連續的儲存格中達到全選的功能，應用到上述的小技巧中。
04.垂直全選到最頂端，按下Ctrl+Shift+↑上箭頭鍵。
垂直全選到最底端，按下Ctrl+Shift+↓下箭頭鍵。
平行全選到最前端，按下Ctrl+Shift+←左鍵頭鍵。
平行全選到最後端，按下Ctrl+Shift+→右箭頭鍵。
05.相同的，利用滑鼠也能達到這個效果。只要按住鍵盤的Shift鍵再點擊選取框的四周兩次。如按著Shift鍵快擊選取框右側兩次。
06.便會自動全選至最右端。
07.如果這時候我們持續按住Shift鍵，點擊選取框下方兩次，便會繼續向下全選整個範圍。相同的，按著Ctrl+Shift+↓鍵也能達到相同效果。
08.那到資料的最前方與最後方呢？這時候就得利用Home與End鍵了。
移動到資料最前端，按下鍵盤的Ctrl+Home鍵。
移動到資料最後端，按下鍵盤的Ctrl+End鍵。
09.也可以配合Shift鍵達到選取的功能。
由目前儲存格選取到資料最前端範圍，按下鍵盤的Ctrl+Shift+Home鍵。
由目前儲存格選取到資料最後端範圍，按下鍵盤的Ctrl+Shift+End鍵。
三、還有一個有趣的小技巧。
10.先隨意選擇一個欄位。
11.按下鍵盤的Shift+Space Bar(空白鍵)，系統會自動選取整列唷。
當然在資料量少的時候，這些動作展現不出實用性。但若是資料量數千數萬行，這些小技巧可為大家節省許多時間哦。
方法：
一、將儲存格移動到欄或列的最前方或最後方。
01.垂直移動到最頂端，按下Ctrl+↑上箭頭鍵。
垂直移動到最底端，按下Ctrl+↓下箭頭鍵。
平行移動到最前端，按下Ctrl+←左鍵頭鍵。
平行移動到最後端，按下Ctrl+→右箭頭鍵。
02.除了利用鍵盤可以控制，那滑鼠可以嗎？答案是可以的。只要你點選儲存格黑框的四邊兩次，如黑框下方滑鼠左鍵快擊兩下。
03.選取框便會自動跳至最底端。
二、加上Shift鍵達到連續格選取功能。
我們知道按住Shift鍵可在連續的儲存格中達到全選的功能，應用到上述的小技巧中。
04.垂直全選到最頂端，按下Ctrl+Shift+↑上箭頭鍵。
垂直全選到最底端，按下Ctrl+Shift+↓下箭頭鍵。
平行全選到最前端，按下Ctrl+Shift+←左鍵頭鍵。
平行全選到最後端，按下Ctrl+Shift+→右箭頭鍵。
05.相同的，利用滑鼠也能達到這個效果。只要按住鍵盤的Shift鍵再點擊選取框的四周兩次。如按著Shift鍵快擊選取框右側兩次。
06.便會自動全選至最右端。
07.如果這時候我們持續按住Shift鍵，點擊選取框下方兩次，便會繼續向下全選整個範圍。相同的，按著Ctrl+Shift+↓鍵也能達到相同效果。
08.那到資料的最前方與最後方呢？這時候就得利用Home與End鍵了。
移動到資料最前端，按下鍵盤的Ctrl+Home鍵。
移動到資料最後端，按下鍵盤的Ctrl+End鍵。
09.也可以配合Shift鍵達到選取的功能。
由目前儲存格選取到資料最前端範圍，按下鍵盤的Ctrl+Shift+Home鍵。
由目前儲存格選取到資料最後端範圍，按下鍵盤的Ctrl+Shift+End鍵。
三、還有一個有趣的小技巧。
10.先隨意選擇一個欄位。
11.按下鍵盤的Shift+Space Bar(空白鍵)，系統會自動選取整列唷。
當然在資料量少的時候，這些動作展現不出實用性。但若是資料量數千數萬行，這些小技巧可為大家節省許多時間哦。
如何讓電腦開機後自動登入XP
| 每次開機都會出現XP的登入畫面，很多人可能會覺得每次都得輸入密碼登入相當煩人，如果你的電腦只有你一個人在用，且不擔心閒雜人等開你的電腦，那麼可以按照下面的方法來設定，讓你的Windows XP開機時不會出現輸入帳號、密碼的登入畫面，直接幫你跳到XP桌面，加快開機速度！ | |
 | |
| STEP1 | 依序按下桌面左下角的「開始」→「執行」，準備執行設定指令。 出現「執行」對話盒後，直接在「開啟」欄中輸入「control userpasswords2」，然後再 按下「確定」。 |
 | |
| STEP2 | 出現「使用者帳戶」對話盒後，點選「進階」後，再取消「必須輸入使用者名稱和密碼，才能使用這台電腦」左邊的勾選狀態，最後再按下〔套用〕，讓電腦以你選擇的帳號自動登入XP。 |
 | |
| STEP3 | 出現「自動登入」對話盒後，依序在「密碼」、「確認密碼」欄中輸入你原本的XP登入密碼，如果之前沒設定密碼，就留空白不管他。設定好之後，再按下「確定」，回到「使用者帳戶」對話盒後，一樣按下「確定」完成全部設定工作。以後，當你再重開機時，電腦便會自動登入Windows XP，不用再花時間輸入密碼啦！ |
訂閱：
文章 (Atom)