Excel VBA | 中級・上級 VBA 総合セット（100問）

Sub SpeedUpScreen()
    Application.ScreenUpdating = False
    
    Dim i As Long
    For i = 1 To 10000
        Cells(i, 1).Value = i
    Next i
    
    Application.ScreenUpdating = True
End Sub

Sub SpeedUpScreen()
    Application.ScreenUpdating = False
    
    Dim i As Long
    For i = 1 To 10000
        Cells(i, 1).Value = i
    Next i
    
    Application.ScreenUpdating = True
End Sub

Sub ManualCalc()
    Application.Calculation = xlCalculationManual
    
    Range("B2:B10000").Value = 1
    
    Application.Calculation = xlCalculationAutomatic
End Sub

Sub ManualCalc()
    Application.Calculation = xlCalculationManual
    
    Range("B2:B10000").Value = 1
    
    Application.Calculation = xlCalculationAutomatic
End Sub

Sub ArrayProcess()
    Dim arr As Variant, i As Long
    
    arr = Range("C2:C10000").Value
    
    For i = 1 To UBound(arr, 1)
        If IsNumeric(arr(i, 1)) Then arr(i, 1) = arr(i, 1) * 1.1
    Next i
    
    Range("C2:C10000").Value = arr
End Sub

Sub ArrayProcess()
    Dim arr As Variant, i As Long
    
    arr = Range("C2:C10000").Value
    
    For i = 1 To UBound(arr, 1)
        If IsNumeric(arr(i, 1)) Then arr(i, 1) = arr(i, 1) * 1.1
    Next i
    
    Range("C2:C10000").Value = arr
End Sub

Sub WithExample()
    With Range("A1")
        .Font.Bold = True
        .Font.Color = vbBlue
        .Interior.Color = vbYellow
    End With
End Sub

Sub WithExample()
    With Range("A1")
        .Font.Bold = True
        .Font.Color = vbBlue
        .Interior.Color = vbYellow
    End With
End Sub

Sub NoSelect()
    Range("B2").Value = "OK"
    Range("B2").Font.Bold = True
End Sub

Sub NoSelect()
    Range("B2").Value = "OK"
    Range("B2").Font.Bold = True
End Sub

Sub DisableEvents()
    Application.EnableEvents = False
    
    Range("D2:D10000").Value = 1
    
    Application.EnableEvents = True
End Sub

Sub DisableEvents()
    Application.EnableEvents = False
    
    Range("D2:D10000").Value = 1
    
    Application.EnableEvents = True
End Sub

Sub ProgressBar()
    Dim i As Long
    For i = 1 To 10000
        Cells(i, 1).Value = i
        If i Mod 1000 = 0 Then Application.StatusBar = "進捗: " & i
    Next i
    Application.StatusBar = False
End Sub

Sub ProgressBar()
    Dim i As Long
    For i = 1 To 10000
        Cells(i, 1).Value = i
        If i Mod 1000 = 0 Then Application.StatusBar = "進捗: " & i
    Next i
    Application.StatusBar = False
End Sub

Sub RemoveDuplicatesFast()
    Dim arr As Variant, dict As Object, i As Long
    arr = Range("A2:A1000").Value
    Set dict = CreateObject("Scripting.Dictionary")
    
    For i = 1 To UBound(arr, 1)
        dict(arr(i, 1)) = 1
    Next i
    
    Range("C2").Resize(dict.Count, 1).Value = Application.Transpose(dict.Keys)
End Sub

Sub RemoveDuplicatesFast()
    Dim arr As Variant, dict As Object, i As Long
    arr = Range("A2:A1000").Value
    Set dict = CreateObject("Scripting.Dictionary")
    
    For i = 1 To UBound(arr, 1)
        dict(arr(i, 1)) = 1
    Next i
    
    Range("C2").Resize(dict.Count, 1).Value = Application.Transpose(dict.Keys)
End Sub

Sub UnionExample()
    Dim rng As Range
    Set rng = Union(Range("A1:A10"), Range("C1:C10"))
    rng.Interior.Color = vbGreen
End Sub

Sub UnionExample()
    Dim rng As Range
    Set rng = Union(Range("A1:A10"), Range("C1:C10"))
    rng.Interior.Color = vbGreen
End Sub

Sub FastDeleteSheet()
    Application.DisplayAlerts = False
    Sheets("Temp").Delete
    Application.DisplayAlerts = True
End Sub

Sub FastDeleteSheet()
    Application.DisplayAlerts = False
    Sheets("Temp").Delete
    Application.DisplayAlerts = True
End Sub