エクセル100本ノック  01 ~ 10

# 1問目 : セルのコピー

## 問題
> 「Sheet1」のA1:C5のセル範囲を、「Sheet2」のA1:C5にコピーしてください。
値も数式も書式も全てコピーしてください。
ただしSelectメソッドは使用禁止
※行高と列幅の設定はしなくて良い。

## 解答

```vb
  sheet1.Range("A1:C5").Copy
  sheet2.Range("A1:C5").PasteSpecial _
                        Paste:=xlPasteAll
  Application.CutCopyMode = False  ' コピーの範囲表示を解除する
```
## 別解
```vb
  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本目：セルのコピー](https://excel-ubara.com/vba100/VBA100_001.html)
  [エクセルの神髄 : セルのコピー&値の貼り付け（PasteSpecial）](https://excel-ubara.com/excelvba1/EXCELVBA341.html)





# 2問目 : セルのコピー
## 問題
> 「Sheet1」のA1:C5のセル範囲を、「Sheet2」のA1:C5にコピーしてください。
数式は消して値でコピー、書式もコピーしてください。
※書式は「セルの書式設定」で設定可能なもの（ロックは除く）。

## 別解
```vb
  sheet1.Range("A1:C5").Copy
  sheet2.Range("A1").PasteSpecial _
                     Paste:=xlPasteValues   ' 値貼り付け
  sheet2.Range("A1").PasteSpecial _
                     Paste:=xlPasteFormats  ' 書式貼り付け
  Application.CutCopyMode = False
```

## ポイント
　・貼り付けを別々にやってもいいよという考え





# 3問目 : セルの値消去
## 問題
> A2から、右下終端までの値を削除する。(先頭行、先頭列だけ値を残す。)

## 解答
```vb
  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 = ""
```

## 別解
```vb
  sheet.Range("A1").CurrentRegion.Offset(1, 1) = ""
```

## ポイント
　・CurrentRegionでA1から右下までの領域を取得できる。
　・取得した上でOffsetで領域をずらしている。
　・万が一、値が下端、右端まで埋まってたなら、
　　Offsetでずらしたときにオーバーフローを起してエラーになる。(ほぼあり得ないが)
  ・厳密にあふれを気にする場合、Resizeを用いて領域を縮める。
## 
![ssss.PNG](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/505426/f980692d-a870-0dde-2f87-fb2cd8795641.png)


# 4問目 : セルの消去
## 問題
> 定数値のセルだけ値を消去します。

## 解答

```vb
  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
```

## 別解
```vb
  With sheet
   Set r = .Range("A1").CurrentRegion.Offset(1, 1)
   ' 削除対象のセルが0件の場合のエラーを無視する。
   On Error Resume Next
   ' 定数のみを削除する。
   r.SpecialCells(xlCellTypeConstants).ClearContents
  End With
```

## ポイント
　・SpecialCellsによって、書式別に削除することができる。
　・xlCellTypeConstantsの場合は定数。

## リンク
  [SpecialCellsについて](https://excel-ubara.com/vba100/VBA100_004.html)

# 5問目:セルの計算
## 問題
> B列×C列を計算した値をD列に入れ、通貨\のカンマ編集で表示してください。
ただしB列またはC列が空欄の場合は空欄表示にしてください。
例.D2にはB3×C3の計算結果の値を「\234,099」で表示、D5は空欄

## 解答
```vb
    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
```

## 別解
```vb
  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円の時「&yen;」のみが表示されないよう「&yen;#,###」でなく「&yen;#,##0」を使用すべき。
　


# 6問目:セルに計算式
## 問題
> D列にB列×C列の計算式を入れてください。
ただし商品コードに"-"の枝番が付いている場合は計算式を入れずそのままにしてください。
例.D2にはA2×B2の計算式を入れる。D4:D5には計算式を入れない。

## 解答
```vb
    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
```

## 別解
```vb
　' 計算結果でなく「数式」を格納する。
  .Range("D" & y).FormulaR1C1 = "=RC[-2]*RC[-1]"
```

## ポイント
　・問題を把握できておらず、「数式」ではなく「計算結果」を入れてしまった。
　・「数式」を入れるにはFormulaを使用する。


# 7問目: 「文字列の日付判定」と「日付の月末変換」
## 問題
> A列は文字列データ（表示形式が文字列）で日付が入っています。
日付とみなされる場合はB列に月末日付をmmddの形式で出力してください。
日付け以外の場合は空欄にしてください。
例.B2は「0930」と出力する。

## 解答
```vb
    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
```

## 別解
```vb
  ' DateSerialに「0指定」で前月末日が求まる。
  Cells(i, 2) = Format(DateSerial(Year(d), Month(d) + 1, 0), "'mmdd")
```

## ポイント
　・末日はDateSerialで求めると効率的！



# 8問目:点数の合否判定
## 問題
> 「成績表」シートに5教科の成績表があります。
以下の2条件を満たした者が合格となります。
・5教科合計が350点以上
・全ての科目が50点以上
G列に、合格者に対しては「合格」と出力し、不合格は空欄にしてください。

## 解答
```vb
  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
```

## 別解
```vb
  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列に列挙してください。
※点数は非公開なので「合格者」シートには間違っても出力しないでください。
※何度でも実行できるようにしてください。

## 解答
```vb
  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
```

## 別解
```vb
  ' ★シート削除確認／削除処理は省略
  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行目を削除

## 解答
```vb
  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
```

## 別解
```vb
  ' フィルター絞りこみ
　.AutoFilter field:=3, Criteria1:=""
  .AutoFilter field:=4, Criteria1:="*削除*", Operator:=xlOr, Criteria2:="*不要*"

  ` 行全体を削除
  rng.EntireRow.Delete
```

## ポイント
・フィルターで絞り込む際はAutoFilterでチェイン出来る。
・行全体を削除する際は、EnteireRowを使用することでApplication.DisplayAlertも不要になる。