用 text 可以 指定數字格式
="The Sum " &TEXT(H7,"HK$#,##0.00_);(HK$#,##0.00)")
Result : "The Sum HK$500,000.00"
2012年11月27日 星期二
用vba讀取在同一資料夾內檔案及其資訊 , 寫在即時運算視窗內
Option Explicit
Sub Get_file_info()
Dim myFso As Scripting.FileSystemObject
Dim myFiles As Scripting.Files
Dim myFile As Scripting.File
Set myFso = New Scripting.FileSystemObject
'指定檔案
Set myFiles = myFso.GetFolder(ThisWorkbook.Path).Files
For Each myFile In myFiles
With myFile
Debug.Print "製作日:" & .DateCreated
Debug.Print "最後存取日:" & .DateLastAccessed
Debug.Print "最後更新日:" & .DateLastModified
Debug.Print "Root磁碟機名:" & .Drive
Debug.Print "檔案名稱:" & .Name
Debug.Print "上層資料夾名稱:" & .ParentFolder
Debug.Print "路徑:" & .Path
Debug.Print "DOS用短名稱:" & .ShortName
Debug.Print "DOS用短路徑:" & .ShortPath
Debug.Print "大小:" & (.Size / 1024) & "KB"
Debug.Print "類型:" & .Type
End With
Next
2012年9月22日 星期六
Excel VBA 選欄 或 選行
Excel VBA 選欄 或 選行
BASIC : Columns() & Rows() only accepts one value, an integer of the column/row number.
(1) 選1行 或 選1欄
基本
Columns("B:B").Select
Rows("2:2").Select
可用變數的方法
Range(Columns(2), Columns(2)).Select '選B欄 (1欄)
Range(Rows(2), Rows(2)).Select '選第2行 (1行)
(2) 選連續多行 或 選連續多欄
基本
Columns("B:D").Select
Rows("2:4").Select
可用變數的方法
Range(Columns(2), Columns(4)).Select '選B欄,C欄,D欄 (3欄)
Range(Rows(2), Rows(4)).Select '選第2行,第3行,第4行 (3行)
(3) 選多行 或 選多欄 (不連續)
基本
Range("B:B,D:D,G:G").Select
Range("1:1,4:4,10:10").Select
可用變數的方法
Union(Rows(2),Rows(4),Rows(7)).Select '選B欄,D欄,G欄 (3欄)
Union(Columns(1), Columns(4), Columns(10)).Select '選第1行,第4行,第10行 (3行)
2012年8月6日 星期一
Using VBA to write VBA code (create multiple buttons)
Sub AddComm_button()
Dim myButton As New OLEObject
Dim sCode As String
Dim iX As Integer
Dim CurSheet As Worksheet
Set CurSheet = Worksheets("Sheet1")
For iX = 1 To 2
Set myButton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1")
myButton.Left = 126 * iX
myButton.Top = 96
myButton.Width = 126.75
myButton.Height = 25.5
Set myButton = Nothing
Next iX
For iX = 1 To 2
'Code for button
sCode = ""
sCode = "Sub CommandButton" & iX & "_Click()" & vbCrLf
sCode = sCode & " Sheets(""Sheet" & iX & """).Activate" & vbCrLf
sCode = sCode & "End Sub"
'Write code for button
ThisWorkbook.VBProject.VBComponents(CurSheet.Name).Activate
With ThisWorkbook.VBProject.VBComponents(CurSheet.Name).CodeModule
.AddFromString (sCode)
End With
sCode = vbNullString
Next iX
End Sub
SOURCE : http://www.mrexcel.com/archive/VBA/1086.html
MY TRY (It's Work)
Sub CreateButton()
' 可能 出現 "於執行程式碼時出現以下錯誤 - 執行錯誤1004 - 對於VB專案的程式化存取未信任
' 要在 "工具>巨集>安全性 - 信任的來源>信任存取visual basic(v)專案 選項要打V
Dim Obj As Object
Dim Code As String
Sheets("主頁").Select
For i = 1 To 2
h = 32
'create button
Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, Left:=222, Top:=69 + (i + 1) * h, Width:=158, Height:=26)
Obj.Name = "File_Button" & i
'buttonn text
ActiveSheet.OLEObjects(i).Object.Caption = "File_Button" & i
'macro text
Code = "Sub " & "File_Button" & i & "_Click()" & vbCrLf
Code = Code & "Call Module1.Tester" & vbCrLf
Code = Code & "End Sub"
'add macro at the end of the sheet module
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.insertlines .CountOfLines + 1, Code
End With
Next i
End Sub
Sub Tester()
MsgBox "You have click on the test button"
End Sub
Sub Remove_Codes_in_Module()
' remove all code in a Module
Sheets("主頁").Select
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.DeleteLines 1, .CountOfLines
End With
End Sub
Sub AddComm_button()
' Using VBA to write VBA code (create multiple buttons)
Dim myButton As New OLEObject
Dim sCode As String
Dim iX As Integer
Dim CurSheet As Worksheet
x = Sheets("File總表").Range("d1").Value ' Buttom no.
Set CurSheet = Worksheets("主頁")
Sheets("主頁").Select
For i = 1 To x
h = 32
Set myButton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1")
myButton.Left = 222
myButton.Top = 69 + (i - 1) * h
myButton.Width = 158
myButton.Height = 26
myButton.Name = "File_Button" & i
ActiveSheet.OLEObjects(i).Object.Caption = "File_Button" & i
Set myButton = Nothing
Next i
For iX = 1 To x
'Code for button
sCode = ""
sCode = "Sub CommandButton" & iX & "_Click()" & vbCrLf
' sCode = sCode & " Sheets(""Sheet" & iX & """).Activate" & vbCrLf
sCode = sCode & "End Sub"
'Write code for button
ThisWorkbook.VBProject.VBComponents(CurSheet.CodeName).Activate
With ThisWorkbook.VBProject.VBComponents(CurSheet.CodeName).CodeModule
.AddFromString (sCode)
End With
sCode = vbNullString
Next iX
End Sub
Dim myButton As New OLEObject
Dim sCode As String
Dim iX As Integer
Dim CurSheet As Worksheet
Set CurSheet = Worksheets("Sheet1")
For iX = 1 To 2
Set myButton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1")
myButton.Left = 126 * iX
myButton.Top = 96
myButton.Width = 126.75
myButton.Height = 25.5
Set myButton = Nothing
Next iX
For iX = 1 To 2
'Code for button
sCode = ""
sCode = "Sub CommandButton" & iX & "_Click()" & vbCrLf
sCode = sCode & " Sheets(""Sheet" & iX & """).Activate" & vbCrLf
sCode = sCode & "End Sub"
'Write code for button
ThisWorkbook.VBProject.VBComponents(CurSheet.Name).Activate
With ThisWorkbook.VBProject.VBComponents(CurSheet.Name).CodeModule
.AddFromString (sCode)
End With
sCode = vbNullString
Next iX
End Sub
SOURCE : http://www.mrexcel.com/archive/VBA/1086.html
MY TRY (It's Work)
Sub CreateButton()
' 可能 出現 "於執行程式碼時出現以下錯誤 - 執行錯誤1004 - 對於VB專案的程式化存取未信任
' 要在 "工具>巨集>安全性 - 信任的來源>信任存取visual basic(v)專案 選項要打V
Dim Obj As Object
Dim Code As String
Sheets("主頁").Select
For i = 1 To 2
h = 32
'create button
Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, Left:=222, Top:=69 + (i + 1) * h, Width:=158, Height:=26)
Obj.Name = "File_Button" & i
'buttonn text
ActiveSheet.OLEObjects(i).Object.Caption = "File_Button" & i
'macro text
Code = "Sub " & "File_Button" & i & "_Click()" & vbCrLf
Code = Code & "Call Module1.Tester" & vbCrLf
Code = Code & "End Sub"
'add macro at the end of the sheet module
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.insertlines .CountOfLines + 1, Code
End With
Next i
End Sub
Sub Tester()
MsgBox "You have click on the test button"
End Sub
Sub Remove_Codes_in_Module()
' remove all code in a Module
Sheets("主頁").Select
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.DeleteLines 1, .CountOfLines
End With
End Sub
Sub AddComm_button()
' Using VBA to write VBA code (create multiple buttons)
Dim myButton As New OLEObject
Dim sCode As String
Dim iX As Integer
Dim CurSheet As Worksheet
x = Sheets("File總表").Range("d1").Value ' Buttom no.
Set CurSheet = Worksheets("主頁")
Sheets("主頁").Select
For i = 1 To x
h = 32
Set myButton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1")
myButton.Left = 222
myButton.Top = 69 + (i - 1) * h
myButton.Width = 158
myButton.Height = 26
myButton.Name = "File_Button" & i
ActiveSheet.OLEObjects(i).Object.Caption = "File_Button" & i
Set myButton = Nothing
Next i
For iX = 1 To x
'Code for button
sCode = ""
sCode = "Sub CommandButton" & iX & "_Click()" & vbCrLf
' sCode = sCode & " Sheets(""Sheet" & iX & """).Activate" & vbCrLf
sCode = sCode & "End Sub"
'Write code for button
ThisWorkbook.VBProject.VBComponents(CurSheet.CodeName).Activate
With ThisWorkbook.VBProject.VBComponents(CurSheet.CodeName).CodeModule
.AddFromString (sCode)
End With
sCode = vbNullString
Next iX
End Sub
在 vba module 中 delete 所有 code
Sub test()
' remove all code in a Module
Sheets("主頁").Select
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.DeleteLines 1, .CountOfLines
End With
End Sub
VBA 加 BUTTOM 並加 CODE
Adding a VBA CommandButton with its respective the code
Paste these two sections of code into a general module (Module1 for example).
Sub CreateButton()
Dim Obj As Object
Dim Code As String
Sheets("Sheet1").Select
'create button
Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, Left:=200, Top:=100, Width:=100, Height:=35)
Obj.Name = "TestButton"
'buttonn text
ActiveSheet.OLEObjects(1).Object.Caption = "Test Button"
'macro text
Code = "Sub ButtonTest_Click()" & vbCrLf
Code = Code & "Call Tester" & vbCrLf
Code = Code & "End Sub"
'add macro at the end of the sheet module
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
.insertlines .CountOfLines + 1, Code
End With
End Sub
Sub Tester()
MsgBox "You have click on the test button"
End Sub
於執行程式碼時出現以下錯誤 執行錯誤1004 對於VB專案的程式化存取未信任
ANSWER 工具>巨集>安全性 信任的來源>信任存取visual basic(v)專案 選項要打V
MY WORK :
Sub Set_Buttons_Codes() ' 建立按鍵後的程式 x = Sheets("File總表").Range("d1").Value ' Button 需要的數量 For iX = 1 To x a = Cells(4 + iX, 4).Value ' File Exist or not b = Cells(4 + iX, 5).Value ' File Open or not c = Application.WorksheetFunction.VLookup(iX, Range("File總表!A4:e100"), 4, False) ' FILE名 d = Application.WorksheetFunction.VLookup(iX, Range("File總表!A4:e100"), 3, False) ' file路徑 If a = "Y" Then 'Code for button(沒有此檔案) sCode = "" sCode = "Sub File_Button" & iX & "_Click()" & vbCrLf sCode = sCode & "' 沒有此檔案 " & vbCrLf sCode = sCode & "' NOTHING TO DO " & vbCrLf sCode = sCode & "End Sub" ElseIf b = "Y" Then 'Code for button(檔案已開啟) sCode = "" sCode = "Sub File_Button" & iX & "_Click()" & vbCrLf sCode = sCode & "' 檔案已開啟 " & vbCrLf sCode = sCode & "Windows(" & Chr(34) & c & Chr(34) & ").Activate" & vbCrLf sCode = sCode & "End Sub" Else 'Code for button(檔案存在 , 但未開啟) sCode = "" sCode = "Sub File_Button" & iX & "_Click()" & vbCrLf sCode = sCode & "' 檔案存在 , 但未開啟 " & vbCrLf sCode = sCode & "Workbooks.Open Filename:= _" & vbCrLf sCode = sCode & Chr(34) & d & "\" & c & Chr(34) & vbCrLf sCode = sCode & "End Sub" End If 'Write code for button(IN SHEET2) ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).Activate ' With ThisWorkbook.VBProject.VBComponents(CurSheet.CodeName).CodeModule ' .AddFromString (sCode) ' End With 'add macro at the end of the sheet module With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule .InsertLines .CountOfLines + 1, sCode End With sCode = vbNullString Next iX End Sub
2012年7月28日 星期六
EXCEL 發出聲音[用(自定)函數]
是利用(自定)函數去發出聲音的~也蠻實用的~
在 Excel 中, 按 Alt F11 進入 Visiual Basic 編輯器畫面,
點選 [插入]/[模組], 畫面會跳出程式碼視窗, 在裡面複製貼上如下程式:
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Function SndPlay(Pathname As String) As Long
SndPlay = sndPlaySound(Pathname, SND_ASYNC)
End Function
然後切換回到 Excel 工作表, 在某個儲存格(不是A1或C5)輸入如下公式:
=IF(A1 < C5,sndplay("C:\Windows\Media\Windows XP 電話鈴聲.wav"),0)
註: 需確定 "C:\Windows\Media\ "裡有 "Windows XP 電話鈴聲.wav" 這個檔案
於是在 A1 和 C5 裡分別輸入數字, 當 A1 小於 C5 的時候,
電腦就會播放電話鈴聲
注意: 如果大型的聲音 (.wav) 音效檔所指定，而這個呼叫會失敗，以播放整個檔案，您需要調整適當的音效驅動程式上的設定。
轉載於 http://tw.group.knowledge.yahoo.com/smt-knowldge/listitem/view?iid=15
參考 : http://support.microsoft.com/kb/86281/zh-tw
在 Excel 中, 按 Alt F11 進入 Visiual Basic 編輯器畫面,
點選 [插入]/[模組], 畫面會跳出程式碼視窗, 在裡面複製貼上如下程式:
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Function SndPlay(Pathname As String) As Long
SndPlay = sndPlaySound(Pathname, SND_ASYNC)
End Function
然後切換回到 Excel 工作表, 在某個儲存格(不是A1或C5)輸入如下公式:
=IF(A1 < C5,sndplay("C:\Windows\Media\Windows XP 電話鈴聲.wav"),0)
註: 需確定 "C:\Windows\Media\ "裡有 "Windows XP 電話鈴聲.wav" 這個檔案
於是在 A1 和 C5 裡分別輸入數字, 當 A1 小於 C5 的時候,
電腦就會播放電話鈴聲
注意: 如果大型的聲音 (.wav) 音效檔所指定，而這個呼叫會失敗，以播放整個檔案，您需要調整適當的音效驅動程式上的設定。
轉載於 http://tw.group.knowledge.yahoo.com/smt-knowldge/listitem/view?iid=15
參考 : http://support.microsoft.com/kb/86281/zh-tw
2012年7月19日 星期四
用 match 反方向 search 最後一個"同等值"
EXCEL DATE
A: 4 5 4 3 6 7 5 4 5 0 2 6 3
B: 5
=MATCH(2,1/(A1:A13=B1))
confirmed with CTRL+SHIFT+ENTER
formula checks each cell against the target value with (A1:A13=B1) in the array formula, giving an array with TRUE (or 1) for the positions where the cells match, and with FALSE (or 0) for the rest. Dividing 1 by this results in 1s wherever that array was TRUE, and #DIV/0! wherever that array was false. So his formula is evaluated as
=MATCH(2,{#DIV/0!,1,#DIV/0!,#DIV/0!,#DIV/0!,#DIV/0!,1,#DIV/0!,1,#DIV/0!,#DIV/0!,#DIV/0!,#DIV/0!})
Since no '2' is found in the array, and the last value (1) is found in the 9th position, the MATCH returns 9
2012年3月8日 星期四
用 VBA 找 硬碟上 的檔案 (code)
Sub LoopThroughXLS()
Dim sFName As String
sFName = Dir(”*.xls”)
Do While Len(sFName) > 0
Debug.Print sFName
sFName = Dir
Loop
End Sub
簡單用 vba 寫 txt 檔 (文字檔)
Sub Print_Test()
Dim record As String
Open "C:myfile.txt" For Output As #1
record = ""
Print #1, record
record = "GOOD GOOD"
Print #1, record
Print #1, ""
Close #1
End Sub
2012年3月5日 星期一
VBA 加入外部 activeX 項目 或 Library (EXCEL2003)
2012年2月4日 星期六
Excel-進階篩選
來源 : http://isvincent.blogspot.com/2010/08/excel.html
Excel-進階篩選
在 Excel 中要篩選資料，最常用的是「自動篩選」和「進階篩選」，這次來練習進階篩選。
你必須準備一些資料表(如下表)和一個篩選準則，及要篩選的標題。
當你要使用進階篩選時，如果你選取要將篩選結果複製到另一個地方，而不覆蓋原來資料，則你必須告訴 Excel：資料範圍、準則範圍和要複製到那些位置。
其中在同一列上的條件執行邏輯 AND 運算，而不同列上的條件執行邏輯 OR 運算。例如：
(1) 年資>5 AND 性別=男
(2) 年資>5 OR 性別=男
(3) 年資>=5 AND 年資<=10 (篩選年資介於 5~10 年者)
(4) (年資>5 AND 專長=資料庫) OR (性別=男 AND 專長=程式設計)
(5) 你也可以在準則中使用萬用字元，例如：王*、呂*等。(在此萬用字元*，可省略)
(6) 你也可以使用函數運算結果來篩選資料。
例如：儲存格J2：MONTH(E2)=4，表示要取儲存格E2的月份為4。而公式結果顯示為 FALSE，表示 MONTH(E2)=4 的結果為假。在準則上命名一個和原來資料表中不相同的標題(本例為：對象)。如此就可以進行篩選了。
(7) 例如你要篩選出年滿40歲的人員，以今天的日期2010/8/2為準來篩選：
儲存格J2：=E2<=DATE(YEAR(NOW())-40,MONTH(NOW()),DAY(NOW()))
(8) 要篩選年資超過 6 年，而長專長是「資料庫」者。
儲存格J2：=AND(D2>=6,C2="資料庫")
其餘自行練習吧！
你必須準備一些資料表(如下表)和一個篩選準則，及要篩選的標題。
當你要使用進階篩選時，如果你選取要將篩選結果複製到另一個地方，而不覆蓋原來資料，則你必須告訴 Excel：資料範圍、準則範圍和要複製到那些位置。
其中在同一列上的條件執行邏輯 AND 運算，而不同列上的條件執行邏輯 OR 運算。例如：
(1) 年資>5 AND 性別=男
(2) 年資>5 OR 性別=男
(3) 年資>=5 AND 年資<=10 (篩選年資介於 5~10 年者)
(4) (年資>5 AND 專長=資料庫) OR (性別=男 AND 專長=程式設計)
(5) 你也可以在準則中使用萬用字元，例如：王*、呂*等。(在此萬用字元*，可省略)
(6) 你也可以使用函數運算結果來篩選資料。
例如：儲存格J2：MONTH(E2)=4，表示要取儲存格E2的月份為4。而公式結果顯示為 FALSE，表示 MONTH(E2)=4 的結果為假。在準則上命名一個和原來資料表中不相同的標題(本例為：對象)。如此就可以進行篩選了。
(7) 例如你要篩選出年滿40歲的人員，以今天的日期2010/8/2為準來篩選：
儲存格J2：=E2<=DATE(YEAR(NOW())-40,MONTH(NOW()),DAY(NOW()))
(8) 要篩選年資超過 6 年，而長專長是「資料庫」者。
儲存格J2：=AND(D2>=6,C2="資料庫")
其餘自行練習吧！
訂閱：
文章 (Atom)