VBA季

Private Sub Worksheet_Change(ByVal Target As Range)
x = Left(Target.Address, 2)
If x = "$D" Then
Select Case Target.Value
Case 1 To 3
ActiveCell.Offset(-1, 1).Value = "第一季"

Case 4 To 6
ActiveCell.Offset(-1, 1).Value = "第二季"

Case 7 To 9
ActiveCell.Offset(-1, 1).Value = "第三季"

Case 10 To 12
ActiveCell.Offset(-1, 1).Value = "第四季"


End Select
End If


End Sub

VBA - 工作表

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

刪除空白列

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

篩選

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 , 或是與企業結盟