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
![その他([技術者向] コンピューター) イメージ](https://gazo.okwave.jp/okwave/spn/images/related_qa/c205_4_thumbnail_img_sm.png)
お礼
お礼が遅くなり、申し訳ありません。 ありがとうございまた。 アドバイスを参考に試行錯誤の結果、完成しました。 今後もお願いします。
補足
回答ありがとうございます。 すみませんが、初心者のためよくわかりませんのでもう一度教えてください。 Ａ列には、いくつものABCが不規則に並んでいるために、はじめのAは処理できますが、Bになると処理されません。 勉強不足で、すみませんが、ご指導願います。