Private Sub Worksheet_Change(ByVal Target As Range)
x = Left(Target.Address, 2)
If x = "$a" Then
Select Case Target.Value
Case 1
ActiveCell.Offset(-1, 1).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="板橋,中和,永和"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
Case 2
ActiveCell.Offset(-1, 1).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="aa,jj,kk,ll,mm,nn"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
End Select
End If
End Sub
2010年8月20日星期五
VBA - 工作表
刪除空白列
Sub 刪除空白()
Range("A65530").Select
Selection.End(xlUp).Select
x = ActiveCell.Row
Range("A1").Select
For y = 1 To x
If ActiveCell.Value = Empty Then
x1 = ActiveCell.Row
z = x1 & ":" & x1
Rows(z).Select
Selection.Delete Shift:=xlUp
Else
ActiveCell.Offset(1, 0).Select
End If
Next
Range("A1").Select
End Sub
2010年8月19日星期四
篩選
Sub 篩選()
x = InputBox("請輸入需要的資料內容")
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:=x
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
Sheets(2).Select
Selection.AutoFilter
Range("A1").Select
End Sub
合併
Sub 合併工作表()
mydate = Now()
If Month(Now()) < 10 Then
mydate1 = "0" & Month(Now())
newname = Year(mydate) & mydate1 & Day(mydate)
Else
newname = Year(mydate) & Month(mydate) & Day(mydate)
End If
y = InputBox("請輸入合併工作表數量", "世新")
For x = 1 To y
Sheets(x + 1).Select
If x = 1 Then
Range("A1").Select
Else
Range("A2").Select
End If
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Sheets(1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Next
Range("A1").Select
Sheets(1).Name = newname
End Sub
合併工作表
Sub 合併工作表()
For x = 1 To 3
Sheets(x + 1).Select
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Sheets(1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.End(xlDown).Select
Next
End Sub
新工作表
Sub 新工作表()
x = InputBox("請輸入工作表數量", "世新")
Sheets(1).Select
For i = 1 To x Step 1
Sheets.Add
Next
End Sub
自動流水號
Sub 流水號()
i = ActiveCell.Value
x = InputBox("請輸入終止值")
If i = Empty Then
ActiveCell.Value = 1
Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=1, Stop:=x, Trend:=False
Else
Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=1, Stop:=x + i, Trend:=False
End If
End Sub
很久沒來發表 - 加快搜尋
最近學生問我如何讓BLOG可以在搜尋時排名第一
我想了很久 , 不花錢 要排第一
大概要花時間經營
於是我寫了10 個方案供大家參考
可以告訴我其他方法喔
1 要常用[自己要發表]
2 發表要回應 [ 無人回應時 , 自己回應 ]
3 要到別人BLOG留言[ 順便留下BLOG網址 , 最好要去幫人回應 , 這樣才有朋友 ]
4 與他人連結 [ 放別人的連結 , 人也要放您的 , 多多運用RSS ]
5 有空上搜尋 , 找自己的關鍵字 [ 可以請同學幫忙 , 次數多就會累積 ]
6 E_MAIL 通知
7 與微網誌[plurk , facebook]等連結
8 發表一篇關鍵字[在自己的BLOG]
9 參加BLOG的推文 , 例如 : 黑米書籤
10 加入訂閱 - 例如可以讓人訂閱自己的BLOG , 或是與企業結盟
2010年8月1日星期日
2010年7月25日星期日
我的作品 請大家宣傳喔 ONENOTE
有需要的朋友可以參考一下喔
作者：楊玉文
分類：電腦與網路／應用軟體 叢書系列：OFFICE類
出版社：碁峰 出版日期：2010/7/6
ISBN：9789861819822 書籍編號：kk0271011
EXCEL VBA 身份證檢查
1 工具 / 巨集 / VB編輯程式
2 對工作表SHEET1 按左鍵二下
3 於右側視窗輸入
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x
Dim T0, A0, A1, A2, A3, A4, A5, A6, A7, A8, CK, SUM1 As Integer
x = Left(Target.Address, 2)
If x = "$A" Then
If (Len(Target.Value) <> 10) Then
Target.Value = "重新輸入"
Else
T0 = Asc(UCase(Left(Target.Value, 1)))
A1 = (((Val(Right(Target.Value, 9)) \ 100000000) Mod 10) * 8) Mod 10
A2 = (((Val(Right(Target.Value, 8)) \ 10000000) Mod 10) * 7) Mod 10
A3 = (((Val(Right(Target.Value, 7)) \ 1000000) Mod 10) * 6) Mod 10
A4 = (((Val(Right(Target.Value, 6)) \ 100000) Mod 10) * 5) Mod 10
A5 = (((Val(Right(Target.Value, 5)) \ 10000) Mod 10) * 4) Mod 10
A6 = (((Val(Right(Target.Value, 4)) \ 1000) Mod 10) * 3) Mod 10
A7 = (((Val(Right(Target.Value, 3)) \ 100) Mod 10) * 2) Mod 10
A8 = (((Val(Right(Target.Value, 2)) \ 10) Mod 10) * 1) Mod 10
CK = Val(Right(Target.Value, 1))
Select Case T0
Case 65, 77, 87
A0 = 0
Case 75, 76, 89
A0 = 1
Case 74, 86, 88
A0 = 2
Case 72, 85
A0 = 3
Case 84, 71
A0 = 4
Case 70, 83
A0 = 5
Case 69, 82
A0 = 6
Case 68, 81, 79
A0 = 7
Case 67, 80, 73
A0 = 8
Case 66, 78, 90
A0 = 9
Case Else
' ActiveCell.Formula = "重新輸入"
Target.Value = "重新輸入"
End Select
SUM1 = 9 - ((A0 + A1 + A2 + A3 + A4 + A5 + A6 + A7 + A8) Mod 10)
If CK <> SUM1 Then
Target.Value = "重新輸入"
End If
End If
End If
End Sub
4 於A欄輸入身份字號 , 就知到答案了
2010年7月21日星期三
今天到家已是12:10分
今天到家已是12:10 11:00還在新竹上課 網路碰到不能追的美女
[花一朵 ] 政大高材生喔 也是高身材喔 真是萬分高興 ,
但是沒碰到仙丹的朋友 [政大大美女 也是追不到的那一種] 真是萬分
...
回到家妹咕睡了 看了阿咪的照片第三天游泳 與您分享
2010年7月20日星期二
2010年7月19日星期一
2010年7月13日星期二
大家快去參加喔
『老闆最”照”職場最A咖 拿iPhone』
活動方式: 邀請有拿過證照的學員來參賽(不限巨匠)，只要分享拿證照的心得，就OK。最高票的人氣王就可以拿iPhone。活動相當簡單
活動網址: http://www.pcschool.com.tw/activity/99/9906_a/index.aspx
活動時間~8/16
博文
13130