はじめに
今回は上記のようなシートのデータを使ってプログラムしてみよう。それほど大きなデータではないので、手元のExcelシートで同じように作ってみてほしい。
練習プログラム
まずは表から、「ボールペン」があるデータをF列以降に抜き出してよみよう。
結果的には以下のように表示されるようにプログラムしよう。
まずは大体の計画を立てよう。品名はB列にあるので、２行目～10行目までを巡回して、B列に「ボールペン」を見つけたら、その行の A～D列の値を F～I 列にコピーすれば良いだろう。
Sub macro1()
Dim i As Long
For i = 2 To 10
If Cells(i, "B") = "ボールペン" Then
End If
Next i
End Subとりあえず上記のようなプログラムを書いてみた。For文で2行目～10行目までを巡回して、B列の値が「ボールペン」だったら、、、という部分まではこれで良い。
If文の内部はどのようになるだろうか？
ここで、貼り付け先の行指定が必要になる。今回は2行目が先頭で、「ボールペン」の数だけ追加していく形になるので、行数を指定する変数を用意しよう。
Sub macro1()
Dim i As Long
Dim row As Long
row = 2
For i = 2 To 10
If Cells(i, "B") = "ボールペン" Then
'値のコピー
row = row + 1
End If
Next i
End Sub 貼り付け先の行数は row と言う変数を用意した。値のコピーが終了したら、row = row + 1 として値を増加していく。
値のコピーは、Cells(row, “F”) = Cells(i, “A”) のように書けば良いだろう。右辺から左辺にコピーされる。
Sub macro1()
Dim i As Long
Dim row As Long
row = 2
For i = 2 To 10
If Cells(i, "B") = "ボールペン" Then
Cells(row, "F") = Cells(i, "A")
Cells(row, "G") = Cells(i, "B")
Cells(row, "H") = Cells(i, "C")
Cells(row, "I") = Cells(i, "D")
row = row + 1
End If
Next i
End Subこれで結果見てみると。
F列の値が日付になっていない。よく見ると、H列も金額表示ではないね。
これは書式設定がコピーされないからだ。（日付のコピーについては以前やった。）
では、上記のコードに書式設定をコピーするコードを書き加えてみよう。F列とH列だけでOKだ。
Sub macro1()
Dim i As Long
Dim row As Long
row = 2
For i = 2 To 10
If Cells(i, "B") = "ボールペン" Then
Cells(row, "F") = Cells(i, "A")
Cells(row, "F").NumberFormatLocal = Cells(i, "A").NumberFormatLocal
Cells(row, "G") = Cells(i, "B")
Cells(row, "H") = Cells(i, "C")
Cells(row, "H").NumberFormatLocal = Cells(i, "C").NumberFormatLocal
Cells(row, "I") = Cells(i, "D")
row = row + 1
End If
Next i
End Sub 今度は良いようだ。
このプログラムでは、プロパティ値を直接変更したが、今度はCopyメソッドを利用してみよう。
Sub macro2()
Dim i As Long
Dim row As Long
row = 2
For i = 2 To 10
If Cells(i, "B") = "ボールペン" Then
Cells(i, "A").Copy Cells(row, "F")
Cells(i, "B").Copy Cells(row, "G")
Cells(i, "C").Copy Cells(row, "H")
Cells(i, "D").Copy Cells(row, "I")
row = row + 1
End If
Next i
End Sub Copyメソッドでは、「A列の値を F列に」という書き方になるので注意しよう。
本当は、 Destination:=Cells(row, “F”) とするけど、 引数名は省略して良い事になっているのだったね。
更に、Cellsが4行並んでいるが、Rangeを使えば1行で書く事ができる。
Sub macro3()
Dim i As Long
Dim row As Long
row = 2
For i = 2 To 10
If Cells(i, "B") = "ボールペン" Then
Range("A" & i & ":D" & i).Copy Cells(row, "F")
row = row + 1
End If
Next i
End Subだいぶスッキリ書く事ができたが、“A” & i & “:D” & i という書き方が少々難解かもしれない。コピー先は先頭のセルを指定すれば良い事になっている。
実行してみると以下のようになる。
今度は、枠線までコピーされている。値と書式設定のみコピーするには、PasteSpecialメソッドにオプションを指定すれば良い。
Sub macro4()
Dim i As Long
Dim row As Long
row = 2
For i = 2 To 10
If Cells(i, "B") = "ボールペン" Then
Range("A" & i & ":D" & i).Copy
Cells(row, "F").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
row = row + 1
End If
Next i
End Subこれで、値と書式設定をコピーする事ができた。
検索する品目名を変更してみる
検索する品目名を「ボールペン」から「シャープペン」に変更してみよう。簡単だね。
「ボールペン」の部分を「シャープペン」に変更すれば良い。
Sub macro4()
Dim i As Long
Dim row As Long
row = 2
For i = 2 To 10
If Cells(i, "B") = "シャープペン" Then
Range("A" & i & ":D" & i).Copy
Cells(row, "F").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
row = row + 1
End If
Next i
End Sub
実行してみた結果、上記の通りで「ボールペン」の表記が残ってしまった。
プログラムは実際に実行してみて不具合に気づく事が多いので気を付けよう。
これを改善するには実行前にセルをクリアしておけば良いだろう。とりあえず2行目～10行目までをクリアしておこう。
Sub macro5()
Dim i As Long
Dim row As Long
row = 2
Range("F2:I10").Clear
For i = 2 To 10
If Cells(i, "B") = "シャープペン" Then
Range("A" & i & ":D" & i).Copy
Cells(row, "F").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
row = row + 1
End If
Next i
End Sub
今度はうまく行ったようだ。最初にそれまでの値をクリアしておくというのは忘れがちなので注意するようにしよう。まぁ実行してみれば気付く事が多いが、、、
まとめ
練習プログラムでは、プロパティ値を変更する方法から、Copyメソッドを利用する方法に変形させ、Rangeでの表記や、PasteSpecial を利用する方法までを解説した。
最後に品目名を変更する際に、前の値をクリアしておくという手法も教訓として覚えておいてほしい。
今回の内容は、以前やったオブジェクトの使い方をシート上のプログラムに展開した形になる。よくわからなかった人は、こちらを復習しておいてほしい。
コメント