VBA100本ノックチャレンジ:1~10本目
ExcelVBAは個人的によく使っていて、エクセルの神髄さんにもよくお世話になっているんですが、そういえば100本ノックはやったことがありませんでした。
コロナのワクチン接種(一回目)で今日明日とお休みなので、身体がつらくなければちょくちょく進めていきたいです。
まずは1本目。
#VBA100ノック 1本目
— エクセルの神髄 (@yamaoka_ss) October 19, 2020
「Sheet1」のA1:C5のセル範囲を、「Sheet2」のA1:C5にコピーしてください。
値も数式も書式も全てコピーしてください。
ただしSelectメソッドは使用禁止
※行高と列幅の設定はしなくて良い。
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本目。
#VBA100本ノック 2本目
— エクセルの神髄 (@yamaoka_ss) October 20, 2020
「Sheet1」のA1:C5のセル範囲を、「Sheet2」のA1:C5にコピーしてください。
数式は消して値でコピー、書式もコピーしてください。
※書式は「セルの書式設定」で設定可能なもの(ロックは除く)。
入力規則やメモ(旧コメント)は書式ではありません。
「ふりがな」は任意で
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本目。
#VBA100本ノック 3本目
— エクセルの神髄 (@yamaoka_ss) October 21, 2020
画像のように1行目に見出し、A列に№が入っています。
№の行数およびデータ行数は毎回変化します。
この表の見出し(1行目)と№(A列)を残して、データ部分のみ値を消去してください。
※シートはアクティブシート pic.twitter.com/uXrvsihbHD
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本目。
#VBA100本ノック 4本目
— エクセルの神髄 (@yamaoka_ss) October 22, 2020
画像のように1行目に見出し、A列に№が入っています。
この表範囲の一部には計算式が入っています。
(画像の最下行とD列には数式が入っています。)
データ行数は毎回変化します。
見出し行とA列№と計算式は残し、定数値だけを消去してください。
※画像ならB2:C11を消去 pic.twitter.com/kIe4Jns164
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本目。
#VBA100本ノック 5本目
— エクセルの神髄 (@yamaoka_ss) October 23, 2020
画像のようにB2から始まる表があります。
B列×C列を計算した値をD列に入れ、通貨\のカンマ編集で表示してください。
ただしB列またはC列が空欄の場合は空欄表示にしてください。
例.D2にはB3×C3の計算結果の値を「\234,099」で表示、D5は空欄
※ブック・シートは任意 pic.twitter.com/zRBSVikFXL
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本目。
#VBA100本ノック 6本目
— エクセルの神髄 (@yamaoka_ss) October 24, 2020
画像のようにA1から始まる表があります。
D列にB列×C列の計算式を入れてください。
ただし商品コードに"-"の枝番が付いている場合は計算式を入れずそのままにしてください。
例.D2にはB2×C2の計算式を入れる。D4:D5には計算式を入れない。 pic.twitter.com/6Q8reO8A39
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本目。
#VBA100本ノック 7本目
— エクセルの神髄 (@yamaoka_ss) October 25, 2020
A列は文字列データ(表示形式が文字列)で日付が入っています。
日付とみなされる場合はB列に月末日付をmmddの形式で出力してください。
日付け以外の場合は空欄にしてください。
例.B2は「0930」と出力する。
※何をもって日付とみなすかも含めて考えてください。 pic.twitter.com/Y9hNfWJe3N
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本目。
#VBA100本ノック 8本目
— エクセルの神髄 (@yamaoka_ss) October 26, 2020
「成績表」シートに5教科の成績表があります。
以下の2条件を満たした者が合格となります。
・5教科合計が350点以上
・全ての科目が50点以上
G列に、合格者に対しては「合格」と出力し、不合格は空欄にしてください。 pic.twitter.com/xchRpTzVvs
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本目。
#VBA100本ノック 9本目
— エクセルの神髄 (@yamaoka_ss) October 27, 2020
「成績表」シートに5教科の成績とG列に合否判定があります。
「合格者」シートを新規作成し、合格者の氏名だけをA列に列挙してください。
※点数は非公開なので「合格者」シートには間違っても出力しないでください。
※何度でも実行できるようにしてください。 pic.twitter.com/TzOaMaQGBv
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本目。
#VBA100本ノック 10本目
— エクセルの神髄 (@yamaoka_ss) October 28, 2020
画像のように「受注」シートに今月の受注データがあります。
受注数が空欄かつ備考欄に「削除」または「不要」の文字が含まれている行を削除してください。
行の削除は行全体を削除してください。
サンプルでは5行目と10行目を削除
※シートは任意 pic.twitter.com/SIAlWkOFB2
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本目からもまた頑張ってみたいです。