vbaプログラミングについて教えてください。

質問

vba初心者です。下記のようにプログラミングしましたがもっといいプログラムの仕方はないでしょうか。ちょっとごちゃごちゃしていて見にくいです。どなかたお力をお貸しください。
Private Sub データUPDATE輸入_Click()
ActiveSheet.Unprotect
Dim Line As String
Dim Maxrow As String
Sheets("Invoice").Select
Line = 5
　 Do Until Cells(Line, 7).Value = ""
On Error Resume Next
'A列の空欄をコピーして埋める
If Cells(5, 1).Value = "" Then
Cells(Line, 1).Value = ""
ElseIf Cells(Line, 1).Value = "" Then
Cells(Line, 1).Value = Cells(Line - 1, 1).Value
End If

'B列の空欄をコピーして埋める
If Cells(5, 2).Value = "" Then
Cells(Line, 2).Value = ""
ElseIf Cells(Line, 2).Value = "" Then
Cells(Line, 2).Value = Cells(Line - 1, 2).Value
End If

'C列の空欄をコピーして埋める
If Cells(5, 3).Value = "" Then
Cells(Line, 3).Value = ""
ElseIf Cells(Line, 3).Value = "" Then
Cells(Line, 3).Value = Cells(Line - 1, 3).Value
End If

'D列の空欄をコピーして埋める
If Cells(5, 4).Value = "" Then
Cells(Line, 4).Value = ""
ElseIf Cells(Line, 4).Value = "" Then
Cells(Line, 4).Value = Cells(Line - 1, 4).Value
End If

'E列の文字を「輸入シート」から検索しF列に貼り付ける
If Cells(Line, 5).Value = "" Then
Cells(Line, 5).Value = Cells(Line - 1, 5).Value
End If
Cells(Line, 6).Value = Application.WorksheetFunction.VLookup(Cells(Line, 5).Value, Worksheets("輸入Parts").Range("A2:R20000"), 2, 0)
'E列を検索しデータが存在しない場合はF列に「データがありません」を表記
If Cells(Line, 6).Value = "" Then
Cells(Line, 6).Value = "データがありません"
GoTo コピー貼り付け
End If
コピー貼り付け:
If Cells(Line, 6).Value = "データがありません" Then
Cells(Line, 5).Copy 'コピーする
Maxrow = Worksheets("輸入Parts").Range("A1").End(xlDown).Row + 1
Worksheets("輸入Parts").Range("A" & Maxrow).PasteSpecial Paste:=xlPasteValues '値を貼り付け
End If
'H列の空欄をコピーして埋める
If Cells(5, 12).Value = "" Then
Cells(Line, 12).Value = ""
ElseIf Cells(Line, 12).Value = "" Then
Cells(Line, 12).Value = Cells(Line - 1, 12).Value
End If
'E列の文字を「輸入シート」から検索しZ列に貼り付ける
Cells(Line, 26).Value = Application.WorksheetFunction.VLookup(Cells(Line, 5).Value, Worksheets("輸入Parts").Range("A2:R20000"), 3, 0)
'E列を検索しデータが存在しない場合はZ列に「データがありません」を表記
If Cells(Line, 26).Value = "" Then
Cells(Line, 26).Value = "データがありません"
End If
'AD列の空欄をコピーして埋める
If Cells(5, 30).Value = "" Then
Cells(Line, 30).Value = ""
ElseIf Cells(Line, 30).Value = "" Then
Cells(Line, 30).Value = Cells(Line - 1, 30).Value
End If
'E列の文字を「輸入シート」から検索しAM列に貼り付ける
Cells(Line, 39).Value = Application.WorksheetFunction.VLookup(Cells(Line, 5).Value, Worksheets("輸入Parts").Range("A2:R20000"), 18, 0)
'E列を検索しデータが存在しない場合はAM列に「データがありません」を表記
If Cells(Line, 39).Value = "" Then
Cells(Line, 39).Value = "データがありません"
End If
'「Unit price」の計算・円建と外貨建が合わさったインボイスの場合の合計金額
If Cells(Line, 14).Value = "" Then
Cells(Line, 13).Value = Cells(Line, 17).Value * Cells(Line, 33).Value / Cells(Line, 7).Value
Else
Cells(Line, 17).Value = Application.WorksheetFunction.RoundDown(Cells(Line, 14).Value * Cells(Line, 16), 0)
Cells(Line, 15).Value = Cells(Line, 16).Value * Cells(Line, 33).Value / Cells(Line, 7).Value
End If
'T.Invoice Priceの計算
Cells(Line, 23).Value = Application.WorksheetFunction.Sum(Cells(Line, 17), Cells(Line, 18), Cells(Line, 19), Cells(Line, 20), Cells(Line, 21), Cells(Line, 22))
'VLOOKUP関数が終わり、エラーが発生したら止まる
On Error GoTo 0
'次の行に移り最後の行まで検索
Line = Line + 1
Loop
End Sub

回答No.2

めとろいと（@naktak）

VBAでExcelオブジェクトを操作する場合は、オブジェクト(CellやRangeなど)の参照は
時間がかかる為、極力少ない方がベターです。
また、Rangeの文字列指定による参照はパフォーマンスをかなり落とすので、利用しない事がベターです。

色々いじるセルがあるようですから、恐らく、下記ようにして、予め対象行の対象セルを
全部Rangeに入れておいて、そのオブジェクトを使いまわす、がいいかもしれません。
Dim CellSetGroup1 As Range
Dim CellSetGroup2 As Range
Set CellSetGroup1 = Range(Cells(line, 1), Cells(line, 6)) ' A列～F列
Set CellSetGroup2 = Range(Cells(line, 10), Cells(line, 15)) ' J列～O列
MsgBox CellSetGroup1(1).Value ' A1の値を出力
みたいな。

いじってて他に思ったのは、以下の点です。
　・プロシージャを分けて、責任範疇を狭める。

　・マジックナンバーは行わない。
　　5とか7って言われてもどこの列を参照しているのか不透明です。
　　全て必要な列はenumを利用するなどして定義するべきでしょう。

　・Line、MaxRowの型が数値型ではない。正しい型宣言にするべき。

　・リテラル文字は定数定義に変えるべき。
　　"輸入Parts"とか"A2:R20000"とか。

以下、それっぽくリファクタしたコードです。動くのかどうか知りませんし、
何をどうしたいのか理解した上でいじったわけではないので、もっと色んな場所で
改善の余地があると思います。

Private Sub データUPDATE輸入_Click()
On Error GoTo Exception

Dim line As Long
Dim maxRow As Long

ActiveSheet.Unprotect
Sheets("Invoice").Select
line = 5

Do Until Cells(line, 7).Value = ""
' 他のセルを考慮した値出力
Call putJudgeCells(line)

' E列
Call putPreviousCellValue(line, 5)

' 輸入シート関係
Call putSearchCellValue(line)

'「Unit price」の計算・円建と外貨建が合わさったインボイスの場合の合計金額
If Cells(line, 14).Value = "" Then
Cells(line, 13).Value = Cells(line, 17).Value * Cells(line, 33).Value / Cells(line, 7).Value
Else
Cells(line, 17).Value = Application.WorksheetFunction.RoundDown(Cells(line, 14).Value * Cells(line, 16), 0)
Cells(line, 15).Value = Cells(line, 16).Value * Cells(line, 33).Value / Cells(line, 7).Value
End If

'T.Invoice Priceの計算
Cells(line, 23).Value = Application.WorksheetFunction.Sum(Cells(line, 17), Cells(line, 18), Cells(line, 19), Cells(line, 20), Cells(line, 21), Cells(line, 22))

'次の行に移り最後の行まで検索
line = line + 1
Loop

Exit Sub

Exception:
Call MsgBox(Err.Description)

End Sub

'/**
' * 他セル値を考慮するセルの値を出力を行う
' * @param row 行
' * @param column 列
' */
Private Sub putJudgeCells(row As Long)
' A, B, C, D, H, AD列
For Each column In Array(1, 2, 3, 4, 12, 30)
Call putJudgeCellValue(row, CLng(column))
Next

End Sub

'/**
' * 他セル値を考慮して値を出力する
' * @param row 行
' * @param column 列
' */
Private Sub putJudgeCellValue(row As Long, column As Long)
' 5行目のセル判断
With Cells(row, column)
If Cells(5, column).Value = "" Then
.Value = ""
Exit Sub

End If
End With

Call putPreviousCellValue(row, column)

End Sub

'/**
' * 対象セルの前行セルから値を出力する
' * @param row 行
' * @param column 列
' */
Private Sub putPreviousCellValue(row As Long, column As Long)
With Cells(row, column)
If .Value = "" Then
.Value = .Offset(-1, 0).Value
End If
End With

End Sub

'/**
' * 輸入シートから検索を行い、セルの値を出力する
' * @param row 行
' * @param column 列
' */
Private Sub putSearchCellValue(row As Long)
Dim maps(1 To 3) As Variant
maps(1) = Array(6, 2)
maps(2) = Array(26, 3)
maps(3) = Array(39, 18)

For Each map In maps
With Cells(row, CLng(map(0)))
.Value = getInWareHouse(line, map(1))

If .Value = "" Then
.Value = "データがありません"

' F列の場合、輸入シートにセルコピー
If map(0) = 6 Then
Call copyUnmatchKey(row)
End If
End If
End With
Next

End Sub

'/**
' * E5の値から「輸入シート」から対象データを検索する
' * @param row 行
' * @param targetColumn 取得列
' */
Private Function getInWareHouse(row As Long, targetColumn As Long) As String
On Error GoTo Exception

getInWareHouse = Application.WorksheetFunction.VLookup( _
Cells(row, 5).Value, Worksheets("輸入Parts").Range("A2:R20000"), targetColumn, False)
Exit Function

Exception:
If Err.Number = 1004 Then
getInWareHouse = ""
Exit Function
Else
Call Err.Raise(Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End If

End Function

'/**
' * 輸入シート不一致の場合、輸入シートにコピーする
' * @param row 行
' */
Private Sub copyUnmatchKey(row As Long)
Dim maxRow As Long

Cells(row, 5).Copy
maxRow = Worksheets("輸入Parts").Range("A1").End(xlDown).row + 1
Worksheets("輸入Parts").Range("A" & maxRow).PasteSpecial Paste:=xlPasteValues
End Sub

お礼

こんなにすっきりとしたプログラミングになるんですね。ご指導ありがとうございました。参考にさせていただきます。

回答No.1

eden3616

(1)同じような処理は変数でまとめる。
「○列の空欄をコピーして埋める」の処理は全て一つにまとめれます。
たとえば、配列変数 = Split("A,B,C,D,L,AD", ",")
For Each 変数 in 配列変数 ～ Next　（内部のCellはRangeに変更）
のようにして一つのコード内で変数を回し、纏めることが出来ます。

(2)不要な処理を入れない。
以下の処理でIf ～ End Ifが終われば次のコードへ処理が移動するので
Go To～やラベルは不要です。
また、処理１のなかに処理２を入れる。

If Cells(Line, 6).Value = "" Then
　　～処理１～
　　Cells(Line, 6).Value = "データがありません"
　　GoTo コピー貼り付け
End If

コピー貼り付け:
If Cells(Line, 6).Value = "データがありません" Then
　　～処理２～
End IF

(3)一つのオブジェクトに対する処理はWith オブジェクト～End Withを使用
With～End Withを使えば極端かもしれませんが以下のように記述できます。
（場合によっては可読性が悪くなります）

'D列の空欄をコピーして埋める
With Cells(Line, 4)
　　If Cells(5, 4).Value = "" Then
　　　　.Value = ""
　　ElseIf .Value = "" Then
　　　　.Value = .Offset(-1, 0).Value
　　End If
End With

(4)オブジェクト変数に代入してコードを短くする

以下のように変数へオブジェクトを代入すれば変数で範囲を利用できます。
Set オブジェクト変数 = Worksheets("輸入Parts").Range("A2:R20000")
　　　　　　↓
Cells(Line, 26).Value = Application.WorksheetFunction.VLookup(Cells(Line, 5).Value, オブジェクト変数, 3, 0)

(5)Range or Cells オブジェクトのValueプロパティは省略可能
　　RangeやCellsでセル指定した場合のValueプロパティは標準で取得されますので
　　省略できますが、Valueである認識はもっておく必要があります
　　またWith～End Withなどでオブジェクトを省略した場合はValueが必要

こんなところを注意して無駄になっているコード
繰り返し同じことをしているコード
などを最適化してください。ぐっと短いコードになると思います。

お礼

ご指導ありがとうございました。まだまだ知らないことが多いのでもっと勉強します。