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行ずつ転記する(For～Nextでの繰り返し処理)

入力シートの2行目から最下行まで1行ずつ転記することにします。

2行目から順次、転記します。
- 以下のように、データの転記を入力データの最下行まで繰り返すことになります。
  Worksheets("データ").Range("A2:D2").Value =Worksheets("入力").Range("A2:D2").Value
  Worksheets("データ").Range("A3:D3").Value =Worksheets("入力").Range("A3:D3").Value
  Worksheets("データ").Range("A4:D4").Value =Worksheets("入力").Range("A4:D4").Value
  ・・・

繰り返し処理ですので、For～Nextで繰り返すことにします。

開始は2行目からと分かりますが、データが何行目まで入力されているかがわかりませんので、最終行を調べます。
最下行の行番号を変数lastRow1へ入れることにします。
入力データがないとき(lastRow1=1のとき)は転記の必要はないので終了します。

Dim lastRow as Long
　　lastRow1 = Worksheets("入力").Range("A" & Rows.Count).End(xlUp).Row
　　If lastRow1 = 1 Then Exit Sub

これで、For i = 2 to lastRow1　として繰り返せばよいことになります。
右辺は以下のようになります。
左辺はいまのところ「Range("A2:D2").」のままにしておきます。

Dim i as Long
　　For i = 2 To lastRow1
　　　　Worksheets("データ").Range("A2:D2").Value =Worksheets("入力").Range("A" & i　& ":D" & i).Value
　　Next i

次に、左辺の方を考えてみます。
転記先のデータシートのA列最下行の行番号を変数lastRow2へ入れることにします。

Dim lastRow2 as Long
　　lastRow2 = Worksheets("データ").Range("A" & Rows.Count).End(xlUp).Row

転記先の行番号はここで得られた最下行の次の行ですので、 lastRow2 + 1　と + 1します。
よって、左辺は以下のようになります。

Dim i as Long
　　For i = 2 To lastRow1
　　　　lastRow2 = Worksheets("データ").Range("A" & Rows.Count).End(xlUp).Row
　　　　Worksheets("データ").Range("A" & lastRow2 + 1　& ":D" & lastRow2 + 1).Value =Worksheets("入力").Range("A" & i　& ":D" & i).Value
　　Next i

これらをまとめると、以下のようになります。

Dim lastRow as Long
Dim lastRow2 as Long
Dim i as Long
　　lastRow1 = Worksheets("入力").Range("A" & Rows.Count).End(xlUp).Row
　　For i = 2 To lastRow1
　　　　lastRow2 = Worksheets("データ").Range("A" & Rows.Count).End(xlUp).Row
　　　　Worksheets("データ").Range("A" & lastRow2 + 1 & ":D" & lastRow2 + 1).Value = Worksheets("入力").Range("A" & i　& ":D" & i).Value
　　Next i

↓

金額の計算は入力シートのC列の値*D列の値ですので、
.Range("E" & lastRow2 + 1).Value = Sh1.Range("C" & i).Value * Sh1.Range("D" & i).Value
となります。

Sub prog21()
　　Dim Sh1 As Worksheet, Sh2 As Worksheet
　　Dim lastRow1 As Long, lastRow2 As Long
　　Dim i As Long
　　　Set Sh1 = Worksheets("入力")
　　　　Set Sh2 = Worksheets("データ")
　　　　　　　　For i = 2 To lastRow1
　　　　　　　　　lastRow2 = .Range("A" & Rows.Count).End(xlUp).Row
　　　　　　　　　　'金額の計算
　　　　　　　　　　.Range("E" & lastRow2 + 1).Value = Sh1.Range("C" & i).Value * Sh1.Range("D" & i).Value
　　　　　　　　Next i
　　　　　　End With
End Sub

最後に転記後には入力データをクリアします。

　　Worksheets("入力").Range("A2:D" & lastRow1).ClearContents

以上をまとめると、以下のようになります。

Sub prog21()
　　Dim Sh1 As Worksheet, Sh2 As Worksheet
　　Dim lastRow1 As Long, lastRow2 As Long
　　Dim i As Long
　　　　Set Sh1 = Worksheets("入力")
　　　　Set Sh2 = Worksheets("データ")
　　　　　　'入力データの最下行を求める
　　　　　　lastRow1 = Sh1.Range("A" & Rows.Count).End(xlUp).Row
　　　　　　If lastRow1 = 1 Then Exit Sub
　　　　　　With Sh2
　　　　　　　　For i = 2 To lastRow1
　　　　　　　　　　'転記先の最下行を求める
　　　　　　　　　　lastRow2 = .Range("A" & Rows.Count).End(xlUp).Row
　　　　　　　　　　'データを転記する
　　　　　　　　　　.Range(.Range("A" & lastRow2 + 1), .Range("D" & lastRow2 + 1)).Value = _
　　　　　　　　　　　　　Sh1.Range(Sh1.Range("A" & i), Sh1.Range("D" & i)).Value
　　　　　　　　　　'金額の計算
　　　　　　　　　　.Range("E" & lastRow2 + 1).Value = Sh1.Range("C" & i).Value * Sh1.Range("D" & i).Value
　　　　　　　　Next i
　　　　　　End With
　　　　　　'入力データをクリアする
　　　　　　With Sh1
　　　　　　　　.Range("A2:D" & lastRow1).ClearContents
　　　　　　End With
End Sub

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

入力データを配列に読み込んで、一気にデータシートへ書き出してみたいと思います。
ただし、金額の計算はFor～Nextのループで処理しています。

以下のような処理を行っています。
入力データのセル範囲を取得する
↓
入力データを配列myDataに読み込む
↓
配列の2時限目の要素数を4→5ね変更し、金額の計算結果を格納する
↓
入力データをクリア
↓
データシートへ配列myDataの値を書き出す。

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

Sub prog22()
　　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