VBA學習第三課
阿新 • • 發佈：2018-11-29
sheet1 表1 sheets(1) 表格中的第一張表 sheets("十月")表格中的“十月”的那張表
Sub aa()
Sheets(Sheets.Count).Name = "1月"
Dim i As Integer
For i = 2 To 12
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = i & "月"
Next
End Sub
Sub a()
Sheets.Add after:=Sheets(Sheets.Count), Count:=100
Excel.Application.DisplayAlerts = False
Dim a As Integer
For a = 1 To 100
Sheets(Sheets.Count).Delete
Next
Excel.Application.DisplayAlerts = True
End Sub
Sub aa()
Dim i As Integer
For i = 2 To Sheets.Count
Sheets("部門").Range("a" & i - 1) = Sheets(i).Name
Next
End Sub
Sub aa()
Dim i As Integer
For i = 1 To 31
Sheets(Sheets.Count).Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "5月" & i & "日"
Sheets(Sheets.Count).Range("E5") = "2016/05/" & i
Next
End Sub
Sub bb()
Dim i As Integer
For i = 2 To Sheets.Count
Sheet1.Range("B" & i + 8) = Sheets(i).Range("E5")
Sheet1.Range("c" & i + 8) = Sheets(i).Range("E6")
Sheet1.Range("d" & i + 8) = Sheets(i).Range("E44")
Next
End Sub
Sub aa()
'線性思維 程式碼量大 卡頓
Dim i As Integer
Dim aa As Integer
Dim bb As Integer
For bb = 100 To 1 Step -1
For i = 1 To Sheets.Count
For aa = 1 To 200
'第一迴圈 賦值科目
If Sheets(i).Range("b" & aa) = "" Then
Exit For
End If
If Sheets(i).Range("b" & aa) = "理工" Then
Sheets(i).Range("c" & aa) = "LG"
ElseIf Sheets(i).Range("b" & aa) = "文科" Then
Sheets(i).Range("c" & aa) = "WK"
ElseIf Sheets(i).Range("b" & aa) = "財經" Then
Sheets(i).Range("c" & aa) = "CJ"
End If
'第二迴圈 賦值先生女士
If Sheets(i).Range("e" & aa) = "" Then
Exit For
End If
If Sheets(i).Range("e" & aa) = "男" Then
Sheets(i).Range("f" & aa) = "先生"
ElseIf Sheets(i).Range("e" & aa) = "女" Then
Sheets(i).Range("f" & aa) = "女士"
End If
'第三迴圈 空行刪除
If Sheets(i).Range("d" & bb) = "" Then
Sheets(i).Range("d" & bb).EntireRow.Delete
End If
Next
Next
Next
End Sub
Sub aa()
'優化 尋找共性很重要
Dim i As Integer
Dim aa As Integer
For i = 1 To Sheets.Count
For aa = 200 To 1 Step -1
'第一迴圈 賦值科目
If Sheets(i).Range("b" & aa) = "理工" Then
Sheets(i).Range("c" & aa) = "LG"
ElseIf Sheets(i).Range("b" & aa) = "文科" Then
Sheets(i).Range("c" & aa) = "WK"
ElseIf Sheets(i).Range("b" & aa) = "財經" Then
Sheets(i).Range("c" & aa) = "CJ"
End If
'第二迴圈 賦值先生女士
If Sheets(i).Range("e" & aa) = "男" Then
Sheets(i).Range("f" & aa) = "先生"
ElseIf Sheets(i).Range("e" & aa) = "女" Then
Sheets(i).Range("f" & aa) = "女士"
End If
'第三迴圈 空行刪除
If Sheets(i).Range("d" & aa) = "" Then
Sheets(i).Range("d" & aa).EntireRow.Delete
End If
Next
Next
End Sub