1. 程式人生 > >VBA學習第三課

VBA學習第三課

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