Deprecated: The each() function is deprecated. This message will be suppressed on further calls in /home/zhenxiangba/zhenxiangba.com/public_html/phproxy-improved-master/index.php on line 456
配列を使ってセル範囲に入力する:Excel VBA プログラミング入門

配列を使ってセル範囲に入力する:Excel VBA プログラミング入門

スポンサードリンク

はじめに

1行入力してその都度転記するのは効率が悪いような気がします。
データを複数行入力してから、まとめて、セル範囲に入力する（転記する）ことにしたいと思います。
「入力」シートにデータを入力します。
- 入力シートにはA1:D1のように列見出しを入力しています。
  A列には日付が入りますので、A列の表示形式を「*2001/3/14」としておきます。
  C:D列は「桁区切りスタイル」を設定しておきます。
  データはA2:D11へ入力します。
「データ」シートに入力したデータを転記します。
- 「データ」シートにはA1:E1のように列見出しを入力しています。
  A列には日付が入りますので、A列の表示形式を「*2001/3/14」としておきます。
  C:E列は「桁区切りスタイル」を設定しておきます。
- 転記するデータはA2以降に転記します。

入力データを配列に読み込んでまとめて転記する

入力データを配列に読み込んで、一気にデータシートへ書き出してみたいと思います。
- 以下のような処理を行なおうと思います。
  1. 入力データのセル範囲を取得する
  2. 入力データを配列myDataに入れる
  3. 配列の2時限目の要素数を4→5に変更し、金額の計算結果を格納する
  4. 入力データをクリア
  5. データシートへ配列myDataの値を書き出す。

変数を指定する

使用するワークシートをそれぞれ変数Sh1,Sh2とすることにします。

例えば、Worksheets("入力").Range("A2").Value といった風に書くのですが、わずらわしいので変数で置き換えることにします。
こうすることで、シート名を変更したりしたときは1行書き換えるだけで修正ができるといったメリットもあります。

Sub prog3_1()
　　Dim Sh1 As Worksheet, Sh2 As Worksheet
　　　　Set Sh1 = Worksheets("入力")
　　　　Set Sh2 = Worksheets("データ")
End Sub

入力データのセル範囲を取得する

入力シートの入力データが何行目まであるのかを調べます。最下行の行番号を変数lastRow1へ入れることにします。

1行目には列見出しが入力されているので、A1セルから下方向へどこまでデータが入力されているか調べることで、最下行がわかると思います。
lastRow1=Sh1.Range("A1").End(xlDown).Row　でよさそうですが・・・データが入力されていないときはシートの最下行となります。
ところが、Excel2002や2003では65,536でしたが、Excel2007や2010では1,048,576となっており、バージョンによって異なる値となりちょっと都合が悪そうです。

そこで、シートの最下行から上方向へ調べていくことにすると、入力データがないときは列見出しの行「1」となり、使い勝手がよさそうです。
lastRow1 = .Range("A" & Rows.Count).End(xlUp).Row　とし、
入力データがないときは終了するように　If lastRow1 = 1 Then Exit Sub　としてみました。

Sub prog3_1()
　　Dim Sh1 As Worksheet, Sh2 As Worksheet
　　Dim lastRow1 As Long
　　　　Set Sh1 = Worksheets("入力")
　　　　Set Sh2 = Worksheets("データ")
　　　　　　With Sh1
　　　　　　　　lastRow1 = .Range("A" & Rows.Count).End(xlUp).Row
　　　　　　　　If lastRow1 = 1 Then Exit Sub
　　　　　　End With
End Sub

入力データを配列に入れる

入力データのセル範囲は　Sh1.Range("A2:D" & lastRow1).Value　であるのがわかりましたので、配列myDataへ入れることにします。

Sub prog3_1()
　　Dim Sh1 As Worksheet, Sh2 As Worksheet
　　Dim lastRow1 As Long
　　Dim myData As Variant
　　　　Set Sh1 = Worksheets("入力")
　　　　Set Sh2 = Worksheets("データ")
　　　　　　With Sh1
　　　　　　　　lastRow1 = .Range("A" & Rows.Count).End(xlUp).Row
　　　　　　　　If lastRow1 = 1 Then Exit Sub
　　　　　　　　myData = .Range("A2:D" & lastRow1).Value
　　　　　　End With
End Sub

金額の計算をする

金額は単価*数量で計算できるのですが、計算結果を配列myDataに追加して入れたいと思います。

myData = .Range("A2:D" & lastRow1).Value　としていますので、myData(1 to lastRow1-1,1 to 4)の大きさになっています。
金額を2次元目の5番目に入れると都合がよいので、
配列の要素数を　ReDim Preserve myData(1 To lastRow1 - 1, 1 To 5)　と要素を書き換えない(Preserve)で変更します。
金額の計算は
myData(1,3)*myData(1,4)
myData(2,3)*myData(2,4)
myData(3,3)*myData(3,4)
・・・
と配列myDataの最初から最後までの繰り返しになります。
よって、 For i = LBound(myData) to UBound(myData)　とすることができます。
または、For i = 1 to lastRow1 - 1　とすることもできます。

コードは以下のようにしてみました。

入力データをクリアする

入力シートに入力したデータは転記後は不要ですのでクリアします。
クリアせずにおいたら・・・・間違ってマクロを実行したら、実行するたびに重複して転記されてしまいますので、コード内でクリアするようにします。

データシートへ配列myDataの値を書き出す

データシートの最下行へデータを転記するので、データシートの最下行を求めます。
変数lastRow2へ入れることにします。最終行は　lastRow2 = Sh2.Range("A" & Rows.Count).End(xlUp).Row となりますが、
転記するのは最終行の次の行ですので、+ 1します。
lastRow2 = Sh2.Range("A" & Rows.Count).End(xlUp).Row + 1　となります。
転記先は、Sh2.Range("A" & lastRow2) となるのがわかったので、配列の大きさと同じサイズを確保して、myDataを転記します。
Sh2.Range("A" & lastRow2).Resize(UBound(myData), UBound(myData, 2)).Value = myData

以下のようなコードにしました。

Sub prog3_1()
　　Dim Sh1 As Worksheet, Sh2 As Worksheet
　　Dim lastRow1 As Long, lastRow2 As Long
　　Dim i As Long
　　Dim myData As Variant
　　　　Set Sh1 = Worksheets("入力")
　　　　Set Sh2 = Worksheets("データ")
　　　　　　With Sh1
　　　　　　　　lastRow1 = .Range("A" & Rows.Count).End(xlUp).Row
　　　　　　　　If lastRow1 = 1 Then Exit Sub
　　　　　　　　myData = .Range("A2:D" & lastRow1).Value
　　　　　　　　ReDim Preserve myData(1 To lastRow1 - 1, 1 To 5)
　　　　　　　　For i = LBound(myData) To UBound(myData)
　　　　　　　　　　myData(i, 5) = myData(i, 3) * myData(i, 4)
　　　　　　　　Next i
　　　　　　　　.Range("A2:D" & lastRow1).ClearContents
　　　　　　End With
　　　　　　With Sh2
　　　　　　　　lastRow2 = .Range("A" & Rows.Count).End(xlUp).Row + 1
　　　　　　　　.Range("A" & lastRow2).Resize(UBound(myData), UBound(myData, 2)).Value = myData
　　　　　　End With
End Sub

まとめ

以上で、コードが出来上がりとなります。

Sub prog3_1()
　　Dim Sh1 As Worksheet, Sh2 As Worksheet
　　Dim lastRow1 As Long, lastRow2 As Long
　　Dim i As Long
　　Dim myData As Variant
　　　　Set Sh1 = Worksheets("入力")
　　　　Set Sh2 = Worksheets("データ")
　　　　　　With Sh1
　　　　　　　　lastRow1 = .Range("A" & Rows.Count).End(xlUp).Row
　　　　　　　　If lastRow1 = 1 Then Exit Sub
　　　　　　　　'配列に入力データを読み込む
　　　　　　　　myData = .Range("A2:D" & lastRow1).Value
　　　　　　　　'配列の要素数を変更
　　　　　　　　ReDim Preserve myData(1 To lastRow1 - 1, 1 To 5)
　　　　　　　　'金額の計算
　　　　　　　　For i = LBound(myData) To UBound(myData)
　　　　　　　　　　myData(i, 5) = myData(i, 3) * myData(i, 4)
　　　　　　　　Next i
　　　　　　　　'入力データをクリアする
　　　　　　　　.Range("A2:D" & lastRow1).ClearContents
　　　　　　End With
　　　　　　With Sh2
　　　　　　　　'データシートの最下行の次の行位置を求める
　　　　　　　　lastRow2 = .Range("A" & Rows.Count).End(xlUp).Row + 1
　　　　　　　　'データシートへ配列を書き出す
　　　　　　　　.Range("A" & lastRow2).Resize(UBound(myData), UBound(myData, 2)).Value = myData
　　　　　　End With
End Sub

スポンサードリンク

よねさんのWordとExcelの小部屋｜Excel VBA プログラミング入門：目次｜配列を使ってセル範囲に入力する

PageViewCounter
　 Counter
　Since2006/2/27