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
お礼
B.Offset(0, 1).Value = "●●" で動きました！ ありがとうございました。