えくせるちゅんちゅん

ことりがエクセルをちゅんちゅんするブログ

トップ > VBA > VBAクイズ ことりちゅんからの挑戦状 問1～問20

VBAクイズ ことりちゅんからの挑戦状 問1～問20

VBA ExcelVBAクイズ

今回は最近私の界隈で話題になった、VBAで原因の特定が難しいトラブル例を集めてみましたので出題形式で紹介します。

f:id:Kotori-ChunChun:20190616230553p:plain

はじめに

今回は問題の提示だけで、正解の発表と解説は後日行います。

我こそは！という方は時間のある時に挑戦して下さい。

間違っても「問題になるくらいだから、どうせこっちだろ～」みたいな当てずっぽうの回答はしないでくださいね。

いや、しても構いませんが、せっかくなら分からないなりに「何故これが問題になってるんだろう？」と考えてみるのも一興かと思いますよ。

ルール

出題の前に、ルールを説明しておきます。

特に記載がない限り下記の環境で実行した場合でお考え下さい。

  • 標準モジュールに記載した場合です。

  • Option設定は変更していません。

  • あくまでExcelのVBAです。Accessの場合も同一の結果になることは保証できません。

  • ファイルはマイドキュメントにBook1.xlsmで保存されているものとします。

  • 全ての問題は結果をDebug.Print でイミディエイトに出力された結果を解答とします。セルの内容については問いていません。

  • エラーによる中断はありません。結果はどうあれ、最後までプログラムは走ります。

まあつまり、普通にExcelブックを作成して保存しただけの、最も標準的な環境ですね。

答案用紙

こちらをエクセルにコピペして記入されると、後日発表の解答による採点が容易にできる予定です。

※予め ABC列を セルの書式設定から 「文字列」 に設定しておいてください。

／   答案  解答  結果
---------- 問1 ----------          
1.          
2.          
---------- 問2 ----------          
1.          
---------- 問3 ----------          
1.          
2.          
3.          
---------- 問4 ----------          
1.          
---------- 問5 ----------          
1.          
---------- 問6 ----------          
1.          
---------- 問7 ----------          
1.          
---------- 問8 ----------          
1.          
2.          
---------- 問9 ----------          
1.          
---------- 問10 ----------         
1.          
2.          
3.          
---------- 問11 ----------         
1.          
2.          
---------- 問12 ----------         
1.          
---------- 問13 ----------         
1.          
---------- 問14 ----------         
1.          
---------- 問15 ----------         
1.          
---------- 問16 ----------         
1.          
2.          
3.          
---------- 問17 ----------         
1.          
2.          
---------- 問18 ----------         
1.          
---------- 問19 ----------         
1.          
---------- 問20 ----------         
1.

問題

それでは参りましょ～♪

問１

Sub q_01()
    Range("A2").Resize(2, 2).Merge
    Debug.Print "" & Range("A2").Offset(1).Row
    Debug.Print "" & Range("A1").Offset(2).Row
End Sub

問２

Sub q_02()
    Range("A2").Resize(2, 2).Merge
    Range("A2").Select
    Debug.Print Selection.Address
End Sub

問３

Sub q_03()
    Debug.Print Range("A1:C5").Cells(4).Address
    Debug.Print Range("C3:E5").Cells(0).Address
    Debug.Print Range("C3:C5").Cells(4).Address
End Sub

問４

Sub q_04()
    Dim rng As Range
    Set rng = Range("A1")
    Rows(1).Insert xlDown
    Debug.Print "" & rng.Row
End Sub

問５

Sub q_05()
    Dim rng As Range
    Set rng = Range("H1")
    rng.Cut Range("H2")
    Debug.Print "" & rng.Row
End Sub

問６

Sub q_06()
    Dim data(3, 1)
    data(1, 1) = "A"
    data(2, 1) = "B"
    data(3, 1) = "C"
    Cells(1, 1).Resize(UBound(data, 1), UBound(data, 2)).Value = data
    Debug.Print Cells(1, 1).Value
End Sub

問７

Sub q_07()
    Dim v As Variant
    v = Array("1", "2", "3", "4")
    Range("A1").Resize(UBound(v, 1), 1).Value = WorksheetFunction.Transpose(v)
    Debug.Print Range("A1").Value, Range("A2").Value, Range("A3").Value, Range("A4").Value
End Sub

問８

Sub q_08()
    Range("A1") = "-999-666"
    Range("A2") = "=999-666"
    Debug.Print "" & Range("A1")
    Debug.Print "" & Range("A2")
End Sub

問９

Sub q_09()
    Dim x As Long
    x = 10
    q_09_func (x)
    Debug.Print "" & x
End Sub

Sub q_09_func(ByRef a As Long)
    a = a * 2
End Sub

問10

Sub q_10()
    Dim dtm As Date
    dtm = #1/2/2018 3:04:05 AM#
    Debug.Print "時 : " & Format(dtm, "hh")
    Debug.Print "分 : " & Format(dtm, "mm")
    Debug.Print "秒 : " & Format(dtm, "ss")
End Sub

問11

Sub q_11()
    Dim s() As String
    Dim i As Long
    s = Split("1,2,3", ",")
    For i = 1 To UBound(s)
        Debug.Print s(i)
    Next
End Sub

問12

Sub q_12()
    On Error Resume Next
    If Int("エラーよ起これ！") Then
        Debug.Print "Then"
    Else
        Debug.Print "Else"
    End If
End Sub

問13

Sub q_13()
    If 3 > 2 > 1 Then
        Debug.Print "Then"
    Else
        Debug.Print "Else"
    End If
End Sub

問14

Sub q_14()
    Dim Dic As New Dictionary
    Set Dic = Nothing
    If Dic Is Nothing Then
        Debug.Print "Then"
    Else
        Debug.Print "Else"
    End If
End Sub

問15

Sub q_15()
    Dim Dic As Dictionary
    Set Dic = New Dictionary

    Cells(1, 1) = "a"

    Dic.Add Cells(1, 1), "生きてます"

    Debug.Print Dic("a")
End Sub

問16

長いですが、

  • ①コレクションの場合、Then、Else、Errorのどれか

  • ②ディクショナリの場合、Then、Else、Errorのどれか

  • ③終了時点でディクショナリに"A"が存在するかどうか

の3つをお答えください。

VBAのエラー処理をJavaとかC#風にするな、ちゃんとResumeしろって偉い人から怒られそう(・8・)

Sub q_16()
    
    '①コレクションver
    Dim Col As Collection
    Set Col = New Collection
    
    On Error GoTo Catch_Collection
Try_Collection:
    If Col("A") = "aaa" Then
        Debug.Print "Then"
    Else
        Debug.Print "Else"
    End If
    GoTo Finally_Collection
    
Catch_Collection:
    On Error GoTo -1
    Debug.Print "Error"
    
Finally_Collection:
    On Error GoTo -1
    
    '②ディクショナリver
    Dim Dic As Dictionary
    Set Dic = New Dictionary
    
    On Error GoTo Catch_Dictionary
Try_Dictionary:
    If Dic("A") = "aaa" Then
        Debug.Print "Then"
    Else
        Debug.Print "Else"
    End If
    GoTo Finally_Dictionary
    
Catch_Dictionary:
    On Error GoTo -1
    Debug.Print "Error"
    
Finally_Dictionary:
    On Error GoTo -1
    
    '③ディクショナリ存在確認
    If Dic.Exists("A") Then
        Debug.Print "存在する"
    Else
        Debug.Print "存在しない"
    End If
    
End Sub

問17

2つの解答があります。

  • ①Excel 2007/2010の環境の場合
  • ②Excel 2013/2016の環境の場合
Sub q_17()
    '前提
    With Workbooks.Add
        .Sheets(1).Cells(1, 1).Value = "ブック２"
        
        .Windows(1).WindowState = xlMinimized
        
        Application.DisplayAlerts = False
        .SaveAs ThisWorkbook.Path & "\" & "Book2.xlsx"
        Application.DisplayAlerts = True
        
        .Close
    End With

    '使用時
    ThisWorkbook.Windows(1).WindowState = xlNormal
    With Workbooks.Open(ThisWorkbook.Path & "\" & "Book2.xlsx")
        If Application.Version > 14 Then Debug.Print "" '2013以降ダミー出力
        Debug.Print Cells(1, 1)
        If Application.Version <= 14 Then Debug.Print "" '2010以前ダミー出力
        .Close False
    End With
End Sub

問18

Sub q_18()
    Charts.Add Before:=Worksheets(1)
    Debug.Print Worksheets(1).Name
End Sub

問19

様式シートを非表示で持たせておいて、それをコピーして使う場合です。

Sub q_19()
    Dim sh  As Object
    
    '使用：シートtmpを追加し非表示にする
    Worksheets.Add After:=Sheets(1)
    Set sh = ActiveSheet
    sh.Name = "tmp"
    sh.Visible = xlSheetHidden
    
    'tmpの次にtmpのコピーを置く
    sh.Copy After:=sh
    
    Debug.Print Worksheets(3).Name
End Sub

問20

シェイプに名前を付けて管理する場合です。

Sub q_20()
    With Workbooks.Add
    
        '前提
        With ActiveSheet.Shapes.AddShape( _
                Type:=msoShapeHeart, _
                Left:=1, _
                Top:=1, _
                Width:=100, _
                Height:=100)
            .Name = "ハート 1"
        End With
        
        '使用時
        Dim shp As Shape
        For Each shp In ActiveSheet.Shapes
            If shp.Name = "ハート 1" Then
                Debug.Print shp.TopLeftCell.Address
            End If
        Next
        
    .Close False
    End With
End Sub

まとめ

お疲れ様でした。

もしかしたらベテランの方でもハッとさせられた問題があるのではないでしょうか。もしそうであれば本望です。

VBAに自信満々だった方の心をズタズタに切り裂いたのであれば、ごめんなさい。でも大丈夫です。

私もExcelVBAにはそれなりに自信がありましたが、Twitterを見ていると多くの人が知っているようなことを知らなかった、なんてことは未だによくあります。

解説は後日の予定ですが、実際に動かしてみれば答えをExcelちゃんが教えてくれます。

待ちきれない人は下記のコードを実行してもらえば、答案用紙と同じ様式でイミディエイトウィンドウに答えが出力されますので、後はイコールで結んでみてください。

Sub q_bat()
    Dim SheetNum As Long
    SheetNum = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Dim i As Long
    For i = 1 To 20
        With Workbooks.Add
            On Error Resume Next
            '実行
            Debug.Print "---------- 問" & i & " ----------"
            Application.Run "q_" & Format(i, "00")
            .Close False
        End With
    Next
    Application.SheetsInNewWorkbook = SheetNum
End Sub

以上

解説

問1～問5の解説 Excel VBAのRange操作の注意事項

www.excel-chunchun.com

問6～問8の解説 VBAの配列処理の注意事項

www.excel-chunchun.com

問9～問13の解説 VBAの文法の注意事項

www.excel-chunchun.com

問14～問16の解説 Dictionaryの注意事項

www.excel-chunchun.com

問17～問20の解説 VBA実務上のトラブル事例

www.excel-chunchun.com

何か御座いましたらコメント欄、またはTwitterからどうぞ♪

それではまた来週♪　ちゅんちゅん(・8・)