Excel Basic

Option Explicit

Sub Variable()
'    Dim Score As Integer
'    Score = 100
'    MsgBox Score
'
'    Dim Price As Double
'    Price = 9.6
'    MsgBox Price
'
'    Dim Birthday As Date
'    Birthday = #4/23/2021#
'    MsgBox Birthday
'
'    Dim Message As String
'    Message = "Hello, World!"
'    MsgBox Message
'
'    Dim Pass As Boolean
'    Pass = True
'    MsgBox Pass

'    Dim Score As Integer, Price As Double
'    MsgBox Score
'    MsgBox Price
'
'    Dim var
'    var = 10
'    MsgBox var
'    var = #4/24/2021#
'    MsgBox var

'    MsgBox Scoe  'Option Explicit variable not defined

End Sub

Sub StaticCount()
    Static Count As Integer

    Count = Count + 1

    MsgBox Count
End Sub


Sub Constant()

    Const PI As Double = 3.14

    Dim Area As Double

    Area = PI * 2 * 2

    MsgBox Area

    'vbRed 内置常量
    ActiveCell.Interior.Color = vbRed

End Sub

Sub SelectCase()

    Dim Score As Integer

    Score = 100

    Select Case Score
        Case Is >= 90
            MsgBox "good"
        Case Is >= 70
            MsgBox "normal"
        Case Else
            MsgBox "bad"
    End Select
End Sub

Sub ForLoop()

    Dim Num As Integer
    Dim Total As Integer

    For Num = 1 To 100 Step 2
        If Num > 50 Then
            Exit For
        End If

        Total = Total + Num

        Next Num

    MsgBox Total
End Sub


Sub DoWhile()

    Dim Num As Integer
    Dim Total As Integer

    Do While Num <= 100
        Total = Total + Num
        Num = Num + 1
    Loop

    MsgBox Total
End Sub


Sub DoUntil()

    Dim Num As Integer
    Dim Total As Integer

    Do Until Num > 100
        Total = Total + Num
        Num = Num + 1
    Loop

    MsgBox Total
End Sub

Sub ArrayTest()
    Dim MyArray(1 To 3) As Integer
'    Dim MyArray(3) As Integer  3 代表最大下标，最小默认为 0, Option Base 1 可以指定最小下标为 1

    MyArray(1) = 1
    MyArray(2) = 2
    MyArray(3) = 3

    Dim Index As Integer

'    For Index = 1 To 3
'        MsgBox MyArray(Index)
'        Next Index


    For Index = LBound(MyArray) To UBound(MyArray)
        MsgBox MyArray(Index)
        Next Index
End Sub


Sub DoubleDimensionArrayTest()
    Dim MyArray(1 To 2, 1 To 3) As Integer

    MyArray(1, 1) = 11
    MyArray(1, 2) = 12
    MyArray(1, 3) = 13

    MyArray(2, 1) = 21
    MyArray(2, 2) = 22
    MyArray(2, 3) = 23

    Dim Row As Integer, Col As Integer

    For Row = LBound(MyArray, 1) To UBound(MyArray, 1)
        For Col = LBound(MyArray, 2) To UBound(MyArray, 2)
            MsgBox MyArray(Row, Col)
            Next Col
        Next Row
End Sub


Sub DynamicArrayTest()

    Dim MyArray() As Integer

    ReDim MyArray(1 To 3)
    MyArray(1) = 1
    MyArray(2) = 2
    MyArray(3) = 3


    Dim Index As Integer
    For Index = LBound(MyArray) To UBound(MyArray)
        MsgBox MyArray(Index)
        Next Index

    ReDim MyArray(1 To 2, 1 To 3) As Integer
    MyArray(1, 1) = 11
    MyArray(1, 2) = 12
    MyArray(1, 3) = 13

    MyArray(2, 1) = 21
    MyArray(2, 2) = 22
    MyArray(2, 3) = 23

    Dim Row As Integer, Col As Integer

    For Row = LBound(MyArray, 1) To UBound(MyArray, 1)
        For Col = LBound(MyArray, 2) To UBound(MyArray, 2)
            MsgBox MyArray(Row, Col)
            Next Col
        Next Row

End Sub

Sub ObjectHierarchy()
'    Application.Workbooks("Excel.xlsm").WorkSheets("VBA").Range("A6").Value = 6
    Range("A6").Value = 66
'    Range("A6").Clear
    MsgBox Worksheets("VBA").Name
'    Worksheets.Add
End Sub

Sub CellRefTest()
    Range("A1").Value = 1

    Range("A1, A2, A3").Value = 2

    Range("A1:A3").Value = 3

    Range("A1:A3, C1:C3").Value = 4

    Range("test").Value = 5 ' 引用单元格名称

    Range("10:10").Value = 6

    Range("D:D").Value = 7

    Range("11:11, 13:13").Value = 8

    Range("E:E, G:G").Value = 9

    Rows("14:16").Value = 10

    Columns("H:J").Value = 11
End Sub


Sub CellRefTest2()
    Cells(1, 1).Value = 1

    Range(Cells(1, 1), Cells(2, 2)).Value = 2

    ' 引用区域中的单元格
    Range("A3:B4").Cells(2, 2).Value = 3

    Range("A3").Offset(2, 2).Value = 4

    Range("C5").Offset(-2, -2).Value = 5


End Sub


Sub CellRefTest3()
    Range("A1").Select
    Range("A1:B2").Select

    Range("A1").Activate
    Range("A1:B2").Activate

    Range("A1:B2").Select
    Range("B2").Activate

    Selection.Value = 1
    ActiveCell.Value = 2
End Sub


Sub CellRefTest4()
    Rnge("A1").End(xlDown).Select 'CTRL + 向下方向键
    Range("A2").End(xlUp).Select

    Range("A1").End(xlToRight).Select
    Range("B1").End(xlToLeft).Select

    Range("A1").End(xlToRight).End(xlDown).Select
End Sub

Function Concat(rng As Range, Optional sep As String = "") As String
    Dim cell As Range

    For Each cell In rng
        Concat = Concat & cell.Value & sep
    Next cell

    Concat = Left(Concat, Len(Concat) - Len(sep))

End Function

Sub HideColumn()
  Dim sheet As Worksheet

  For Each sheet In ActiveWorkbook.Sheets
     sheet.Columns("A:F").EntireColumn.Hidden = True
     sheet.Columns("O:T").EntireColumn.Hidden = True
  Next

End Sub

Sub CombineSheet()

    Application.DisplayAlerts = False  'Close Worksheets(combineSheetName).Delete alert dialog
    
    Dim beginRow As Integer
    Dim sheet As Worksheet
    Dim rowCount As Integer
    Dim combineSheetName As String
    
    combineSheetName = "Combined"


    On Error Resume Next ' Ignore runtime error, continue execute the code after error
    
    Worksheets(combineSheetName).Delete
    Worksheets.Add(before:=Worksheets(1)).Name = combineSheetName

    ' Copy header
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("B1") ' First column set empty for copy to DB update directly

    For Each sheet In ActiveWorkbook.Sheets
        If sheet.Name <> "Combined" Then
        
            Application.GoTo Sheets(sheet.Name).[A1]
            Selection.CurrentRegion.Select
            Selection.Offset(1, 0).Resize(Selection.Rows.Count - 2).Select ' Don't copy header and last line
            rowCount = Selection.Rows.Count 'Actual copy rowCount
            
            If beginRow = 0 Then ' The first row is header, copy destination from second row
                beginRow = beginRow + 2
            End If
            
            Selection.Copy Destination:=Sheets("Combined").Cells(beginRow, 2)  ' First column set empty for copy to DB update directly
            beginRow = beginRow + rowCount
             
        End If
    Next
    
    ActiveWorkbook.Sheets(combineSheetName).Activate
    Range("A1").EntireRow.Select
    Selection.CurrentRegion.Select
    
    Application.DisplayAlerts = True
End Sub