VBA100本ノックチャレンジ：1～10本目

Yuzunoki

ExcelVBAは個人的によく使っていて、エクセルの神髄さんにもよくお世話になっているんですが、そういえば100本ノックはやったことがありませんでした。

コロナのワクチン接種（一回目）で今日明日とお休みなので、身体がつらくなければちょくちょく進めていきたいです。

まずは1本目。

Public Sub VBA100本ノック_001()
   
   With ThisWorkbook.Worksheets("Sheet1").Range("A1:C5")
       .Copy Destination:=ThisWorkbook.Worksheets("Sheet2").Range(.Address)
       Application.CutCopyMode = False
   End With

End Sub

特に言うことはなし。
>Destination:=ThisWorkbook.Worksheets("Sheet2").Range("A1")
でも良かったし、実際サンプルもそうしていましたが、「A1:C5」にコピーしてくださいとあったので何となくアドレス指定に。

2本目。

Public Sub VBA100本ノック_002()

   Dim wsSrc As Worksheet
   Dim wsDst As Worksheet
   
   Set wsSrc = ThisWorkbook.Worksheets("Sheet1")
   Set wsDst = ThisWorkbook.Worksheets("Sheet2")
   
   With wsSrc.Range("A1:C5")
       .Copy
       wsDst.Range(.Address).PasteSpecial Paste:=xlPasteValues
       wsDst.Range(.Address).PasteSpecial Paste:=xlPasteFormats
       Application.CutCopyMode = False
   End With
   
End Sub

これもそのまま。
この短さならSheetオブジェクト宣言しなくてもいいと思うんですが、自動メンバ表示が楽なのとうろ覚え部分のヒントになったりするので使っています。

3本目。

Public Sub VBA100本ノック_003()
   
   Dim ws As Worksheet
   Set ws = ActiveSheet
   
   With ws.Range("A1").CurrentRegion
       .Resize(.Rows.Count - 1, .Columns.Count - 1).Offset(1, 1).ClearContents
   End With
   
End Sub

このやり方よく使います。
データにこの表以外のデータがないなら、
>ws.Range("A1").CurrentRegion.Offset(1, 1).ClearContents
としたほうがすっきり1文で済みますね。

4本目。

Public Sub VBA100本ノック_004()
  
   Dim ws As Worksheet
   Set ws = ActiveSheet
   
   With ws.Range("A1").CurrentRegion.Offset(1, 1)
       On Error Resume Next
       .SpecialCells(xlCellTypeConstants).ClearContents
       On Error GoTo 0
   End With
   
End Sub

＜失念ポイント＞.SpecialCells(xlCellTypeConstants)に該当するセルがない場合のエラー回避を忘れていました。
上記は答えを見たあとにOn Error Resume Nextを書き足したものです。反省。

5本目。

Public Sub VBA100本ノック_005()
   
   Dim ws As Worksheet
   Set ws = ActiveSheet
   
   With ws.Range("B2").CurrentRegion
       ws.AutoFilterMode = False
       
       .AutoFilter field:=1, Criteria1:="<>"
       .AutoFilter field:=2, Criteria1:="<>"
       
       Dim rngCur As Range
       Set rngCur = .Resize(.Rows.Count - 1, 1).Offset(1, 2)
   End With

   With rngCur
       .ClearContents
       .FormulaR1C1 = "=RC[-2]*RC[-1]"
       .Value = .Value
       .NumberFormatLocal = "\##,#0"
   End With
   
   ws.AutoFilterMode = False
   
End Sub

多分意図してるのはForNextだなと思いつつ、オートフィルタが好きなのでこちらに。
オートフィルタで絞り込んでるときにセル範囲に対して値の代入や数式の設定をおこなうと、表示セルのみに反映されます。

＜失念ポイント①＞
書式設定のプロパティ（NumberFormatLocal）を忘れていたので、マクロ記録して確認しました。
＜失念ポイント②＞
オートフィルタの空白セル以外の選択の書き方を忘れていたので、こちらもマクロ記録して確認しました。空白セル以外の選択は「Criteria1:="<>"」、空白セルのみの選択は「Criteria1:="="」

6本目。

Public Sub VBA100本ノック_006()

   Dim ws As Worksheet
   Set ws = ActiveSheet
   
   With ws.Range("A1").CurrentRegion
       ws.AutoFilterMode = False
       
       .AutoFilter field:=1, Criteria1:="<>*-*"
       
       Dim rngCur As Range
       Set rngCur = .Resize(.Rows.Count - 1, 1).Offset(1, 3)
   End With

   rngCur.FormulaR1C1 = "=RC[-2]*RC[-1]"
   
   ws.AutoFilterMode = False
   
End Sub

5本目と同じ構造にしてしまいました。せっかくだから違うやりかたを試せばよかった。

＜失念ポイント＞
「計算式を入れずそのままにしてください。」を読み足りずに一度rngCur.ClearContentsを入れていました。反省！

7本目。

Public Sub VBA100本ノック_007()

   Dim ws As Worksheet
   Set ws = ActiveSheet
   
   Dim rw As Long
   For rw = 2 To ws.Range("A1").End(xlDown).Row
       Dim myDate As Variant
       myDate = Replace(ws.Cells(rw, 1).Value, ".", "/")
       
       If IsDate(myDate) Then
           myDate = CDate(myDate)
           myDate = Format(DateSerial(Year(myDate), Month(myDate) + 1, 0), "mmdd")
       Else
           myDate = ""
       End If
   
       With ws.Cells(rw, 2)
           .NumberFormatLocal = "@"
           .Value = myDate
       End With
   Next
   
End Sub

シンプルに。IsDateとCDateは便利。
答えを見ると.NumberFormatLocal = "@"は別に要らなかった模様。（mmddの出力とあったので…）

8本目。

Public Sub VBA100本ノック_008()

   Dim ws As Worksheet
   Set ws = ThisWorkbook.Worksheets("成績表")
   
   Dim rw As Long
   For rw = 2 To ws.Range("A1").End(xlDown).Row
       Dim rng As Range
       Set rng = ws.Range(ws.Cells(rw, "B"), ws.Cells(rw, "F"))
       
       Dim ret As String
       ret = ""
       If WorksheetFunction.CountIf(rng, "<50") = 0 Then
           If WorksheetFunction.Sum(rng) >= 350 Then
               ret = "合格"
           End If
       End If
       
       ws.Cells(rw, "G").Value = ret
   Next

End Sub

CellsでRowIndexとColumnIndex指定するときに、ColumnIndexで指定する列番号は数字でもアルファベットでもいい、というのは何気に便利です。
ただし、「文字列の数字（"1"とかString型の変数に入っているとか）」だとエラーを起こすので、IsNumericでTrueならCLngしておくと安全。
（特にWinActorでライブラリのスクリプト修正・作成するときに活用してます。）

9本目。

Public Sub VBA100本ノック_009()

   Const sNewName As String = "合格者"

   Dim ws As Worksheet
   Set ws = ThisWorkbook.Worksheets("成績表")
   
   Dim w As Worksheet
   Dim wsNew As Worksheet
   For Each w In ThisWorkbook.Worksheets
       If w.Name = sNewName Then
           Set wsNew = w
           Exit For
       End If
   Next
   
   If wsNew Is Nothing Then
       ThisWorkbook.Worksheets.Add After:=ws
       Set wsNew = ActiveSheet
       wsNew.Name = sNewName
   End If
   
   wsNew.Columns(1).ClearContents
   
   With ws
       .AutoFilterMode = False
       .Range("A1").AutoFilter field:=7, Criteria1:="合格"
       .Range(.Range("A2"), .Range("A2").End(xlDown)).Copy
       wsNew.Range("A1").PasteSpecial Paste:=xlPasteValues
       Application.CutCopyMode = False
       .AutoFilterMode = False
   End With

End Sub

解説にもあったように、On Error Resume Nextで挟んで「合格者」シートを削除してから新規シート追加した方が短いしすっきりします。
合格者の抽出は、またしてもオートフィルタに頼ってしまいました。バリエーションに乏しいだろうか…つい便利で…。

ラスト10本目。

Public Sub VBA100本ノック_010()

  Dim ws As Worksheet
  Set ws = ThisWorkbook.Worksheets("受注")
  
  With ws.Range("A1").CurrentRegion
      ws.AutoFilterMode = False
      .AutoFilter field:=3, Criteria1:="="
      .AutoFilter field:=4, Criteria1:="=*削除*", Operator:=xlOr, Criteria2:="=*不要*"
      .Offset(1, 0).EntireRow.Delete
      ws.AutoFilterMode = False
  End With

End Sub

締めもオートフィルタ！やっぱり頼りすぎかもしれない。
データが他にない想定で単純に「.Offset(1, 0).EntireRow.Delete」とだけしましたが、もしこの表の下にも行を開けて入力があるようなら、Resizeで範囲を変えるとかRange(Range(”A2”),Range("A2").End(xlDown)).EntireRow.Deleteとかにした方が安全だと思います。

■10本目まで終えて

自分、オートフィルタにめちゃくちゃ頼っているなと思いました。
暗記が苦手なのでちょくちょくうろ覚えでマクロ記録からプロパティを確かめたものもありつつ、動作としては自分の中で持っている範囲で出来てとりあえずよかったです。

あとは処理のバリエーションを増やすべき…。

11本目からもまた頑張ってみたいです。