1問目 : セルのコピー
問題
「Sheet1」のA1:C5のセル範囲を、「Sheet2」のA1:C5にコピーしてください。
値も数式も書式も全てコピーしてください。
ただしSelectメソッドは使用禁止
※行高と列幅の設定はしなくて良い。
解答
sheet1.Range("A1:C5").Copy
sheet2.Range("A1:C5").PasteSpecial _
Paste:=xlPasteAll
Application.CutCopyMode = False ' コピーの範囲表示を解除する
別解
Worksheets("Sheet1").Range("A1:C5").Copy
Destination:=Worksheets("Sheet2").Range("A1")
-- Destination 省略
Worksheets("Sheet1").Range("A1:C5").Copy Worksheets("Sheet2").Range("A1")
Application.CutCopyMode = False ' コピーの範囲表示を解除する
ポイント
・PasteAllの場合、普通にCopyするのと結果は変わらない。
・Copy と Pasteが別の場合、選択範囲の解除が必要。(ユーザはこの間操作しちゃダメ)
・Copyでは行列の幅は変わらない。
リンク
VBA100本ノック 1本目：セルのコピー
エクセルの神髄 : セルのコピー&値の貼り付け（PasteSpecial）
2問目 : セルのコピー
問題
「Sheet1」のA1:C5のセル範囲を、「Sheet2」のA1:C5にコピーしてください。
数式は消して値でコピー、書式もコピーしてください。
※書式は「セルの書式設定」で設定可能なもの（ロックは除く）。
別解
sheet1.Range("A1:C5").Copy
sheet2.Range("A1").PasteSpecial _
Paste:=xlPasteValues ' 値貼り付け
sheet2.Range("A1").PasteSpecial _
Paste:=xlPasteFormats ' 書式貼り付け
Application.CutCopyMode = False
ポイント
・貼り付けを別々にやってもいいよという考え
3問目 : セルの値消去
問題
A2から、右下終端までの値を削除する。(先頭行、先頭列だけ値を残す。)
解答
Dim endRow As Long
Dim endCell As Long
Dim r As Range
endRow = Cells(Rows.Count, 2).End(xlUp).Row ' 下端の行数
endCell = Cells(2, Columns.Count).End(xlToLeft).Column ' 右端の列数
Set r = Range(Cells(2, 2), Cells(endRow, endCell))
r.Value = ""
別解
sheet.Range("A1").CurrentRegion.Offset(1, 1) = ""
ポイント
・CurrentRegionでA1から右下までの領域を取得できる。
・取得した上でOffsetで領域をずらしている。
・万が一、値が下端、右端まで埋まってたなら、
Offsetでずらしたときにオーバーフローを起してエラーになる。(ほぼあり得ないが)
・厳密にあふれを気にする場合、Resizeを用いて領域を縮める。
4問目 : セルの消去
問題
定数値のセルだけ値を消去します。
解答
With sheet
' 最終行を取得
endRow = Cells(Rows.Count, 4).End(xlUp).Row
' 金額列の値を消去
.Range(.Range("D2"), .Range("D" & endRow)).ClearContents
' 合計行の値を消去
.Range(.Range("B" & endRow), .Range("D" & endRow)).ClearContents
End With
別解
With sheet
Set r = .Range("A1").CurrentRegion.Offset(1, 1)
' 削除対象のセルが0件の場合のエラーを無視する。
On Error Resume Next
' 定数のみを削除する。
r.SpecialCells(xlCellTypeConstants).ClearContents
End With
ポイント
・SpecialCellsによって、書式別に削除することができる。
・xlCellTypeConstantsの場合は定数。
リンク
5問目:セルの計算
問題
B列×C列を計算した値をD列に入れ、通貨\のカンマ編集で表示してください。
ただしB列またはC列が空欄の場合は空欄表示にしてください。
例.D2にはB3×C3の計算結果の値を「\234,099」で表示、D5は空欄
解答
Dim currentPos As Long
Dim endPos As Long
endPos = .Cells(Rows.Count, 2).End(xlUp).Row
' すべての行に対して
For currentPos = 3 To endPos
' B列 * C列
Dim goukei As Long
goukei = .Range("B" & currentPos).Value * .Range("C" & currentPos).Value
' B, C列に値がある場合のみ 円表示する。
If goukei <> 0 Then
.Range("D" & currentPos).Value = goukei
.Range("D" & currentPos).NumberFormatLocal = "\#,###"
Else
.Range("D" & currentPos).Value = ""
.Range("D" & currentPos).NumberFormatLocal = "0.00"
End If
Next
別解
Dim i As Long
For i = 3 To Range("B2").CurrentRegion.Rows.Count + 1
If Cells(i, 2) = "" Or Cells(i, 3) = "" Then
Cells(i, 4) = ""
Else
Cells(i, 4) = Cells(i, 2) * Cells(i, 3)
End If
Next
Columns("D").NumberFormatLocal = "\#,##0"
ポイント
・再下端行を取得するのに、「End」でなく「CurrentRegion.Rows.Count」を使用すると、変数への格納が不要でスマートになる。
・0円の時「¥」のみが表示されないよう「¥#,###」でなく「¥#,##0」を使用すべき。
6問目:セルに計算式
問題
D列にB列×C列の計算式を入れてください。
ただし商品コードに"-"の枝番が付いている場合は計算式を入れずそのままにしてください。
例.D2にはA2×B2の計算式を入れる。D4:D5には計算式を入れない。
解答
Dim y As Long
For y = 2 To .Range("A1").CurrentRegion.Rows.Count
' 型番に「-」を含まない場合、計算を行う。
If InStr(.Range("A" & y), "-") = 0 Then
.Range("D" & y).Value = .Range("B" & y).Value * .Range("C" & y).Value
End If
Next
別解
' 計算結果でなく「数式」を格納する。
.Range("D" & y).FormulaR1C1 = "=RC[-2]*RC[-1]"
ポイント
・問題を把握できておらず、「数式」ではなく「計算結果」を入れてしまった。
・「数式」を入れるにはFormulaを使用する。
7問目: 「文字列の日付判定」と「日付の月末変換」
問題
A列は文字列データ（表示形式が文字列）で日付が入っています。
日付とみなされる場合はB列に月末日付をmmddの形式で出力してください。
日付け以外の場合は空欄にしてください。
例.B2は「0930」と出力する。
解答
Dim i As Long
For i = 2 To .Range("A1").CurrentRegion.Rows.Count
' 日付に変換できる場合
If IsDate(.Cells(i, 1)) Then
Dim d As Date
d = CDate(.Cells(i, 1))
' 「翌月1日」-「1日」=「今月月末」
d = DateSerial(Year(d), Month(d) + 1, 1)
d = DateAdd("d", -1, d)
.Cells(i, 2).Value = d
.Cells(i, 2).NumberFormatLocal = "mmdd"
End If
Next
別解
' DateSerialに「0指定」で前月末日が求まる。
Cells(i, 2) = Format(DateSerial(Year(d), Month(d) + 1, 0), "'mmdd")
ポイント
・末日はDateSerialで求めると効率的！
8問目:点数の合否判定
問題
「成績表」シートに5教科の成績表があります。
以下の2条件を満たした者が合格となります。
・5教科合計が350点以上
・全ての科目が50点以上
G列に、合格者に対しては「合格」と出力し、不合格は空欄にしてください。
解答
With ThisWorkbook.Worksheets(1)
Dim i As Long
Dim j As Long
For i = 2 To .Range("A1").CurrentRegion.Rows.Count
Dim over50 As Boolean
Dim goukei As Long
over50 = True
For j = 2 To 6
If .Cells(i, j).Value < 50 Then
over50 = False
End If
goukei = goukei + .Cells(i, j).Value
Next
If over50 = True And goukei >= 350 Then
.Range("G" & i).Value = "合格"
Else
.Range("G" & i).Value = "不合格"
End If
Next
End With
別解
With WorksheetFunction
If .Sum(r.Offset(, 1).Resize(, 5)) >= 350 And _
.CountIf(r.Offset(, 1).Resize(, 5), ">=50") = 5
ポイント
・WorkSheetFunctionを使うことで、非VBAでの関数を使用することができる。
・
9問目:フィルターコピー
問題
「成績表」シートに5教科の成績とG列に合否判定があります。
「合格者」シートを新規作成し、合格者の氏名だけをA列に列挙してください。
※点数は非公開なので「合格者」シートには間違っても出力しないでください。
※何度でも実行できるようにしてください。
解答
Application.DisplayAlerts = False
' 合格者シートが既に存在していたら削除する。
Dim s As Worksheet
For Each s In ThisWorkbook.Worksheets
If s.Name = "合格者" Then
ThisWorkbook.Worksheets("合格者").Delete
End If
Next
' 合格者シートを追加する。
ThisWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "合格者"
Dim resultSheet As Worksheet
Dim goukakusyaSheet As Worksheet
Set resultSheet = ThisWorkbook.Worksheets("成績表")
Set goukakusyaSheet = ThisWorkbook.Worksheets("合格者")
Dim i As Long
Dim goukakusyaCount As Long
' 合格していれば合格者シートに転記する。
With resultSheet
For i = 2 To .Range("A1").CurrentRegion.Rows.Count
If .Cells(i, 7) = "合格" Then
goukakusyaSheet.Range("A1").Offset(goukakusyaCount, 0).Value = .Cells(i, 1).Value
goukakusyaCount = goukakusyaCount + 1
End If
Next
End With
Application.DisplayAlerts = True
別解
' ★シート削除確認／削除処理は省略
With resultSheet
' オートフィルターを削除
.AutoFilterMode = False
' フィルターを追加し、絞り込み、該当行をコピーし、その内容を別シートに転記
With .Range("A1").CurrentRegion.AutoFilter _
Field:=7, Criteria1:="合格" _
.Columns(1).Copy goukakusyaSheet.Range("A1")
End With
.AutoFilterMode = False
End With
ポイント
・オートフィルターを使用することによって該当部分を一度に引っ張っている。
10問目:フィルターコピー
問題
画像のように「受注」シートに今月の受注データがあります。
受注数が空欄かつ備考欄に「削除」または「不要」の文字が含まれている行を削除してください。
行の削除は行全体を削除してください。
サンプルでは5行目と10行目を削除
解答
With ThisWorkbook.Worksheets("受注")
.AutoFilterMode = False
' フィルター : 3行目が空欄
.Range("A1").AutoFilter _
Field:=3, Criteria1:="=", _
Operator:=xlFilterValues
' フィルター : 4列目に削除または不要を含む
.Range("A1").AutoFilter _
Field:=4, Criteria1:="*削除*", _
Field:=4, Criteria2:="*不要*", _
Operator:=XlAutoFilterOperator.xlOr
' 「行全体を削除しますか」というダイアログを非表示にする。
Application.DisplayAlerts = False
.Range("A1").CurrentRegion.Offset(1, 0).Delete
Application.DisplayAlerts = True
.AutoFilterMode = False
End With
別解
' フィルター絞りこみ
.AutoFilter field:=3, Criteria1:=""
.AutoFilter field:=4, Criteria1:="*削除*", Operator:=xlOr, Criteria2:="*不要*"
` 行全体を削除
rng.EntireRow.Delete
ポイント
・フィルターで絞り込む際はAutoFilterでチェイン出来る。
・行全体を削除する際は、EnteireRowを使用することでApplication.DisplayAlertも不要になる。