web-dev-qa-db-ja.com

VBAコードを使用してデータを請求書から販売概要ページに移動する

私は私の友人のためにデータベースを作成しています。彼女は人々が職人の作品を購入できる小さな店を所有しています。職人リストと在庫リストを作成しました。 2枚のシートに、(Vloolupを使用して)アイテムコードに基づいて在庫リストからデータを呼び出し、Artisanの2文字のIDを適用する請求書リストがあります。次に、請求書が決済された後でも、各請求書のデータを各販売のデータを保持する販売シートに移動するVBA式があります。これは、各請求書から「販売」シートにデータを転送するために使用しているコードです。

請求書ページのコピーを含めたので、コードがどこから取得されているかを確認できます

enter image description here

コード:

Sub SavingSalesData()
Dim rng As Range
  Dim i As Long
  Dim a As Long

  Dim rng_dest As Range
  Application.ScreenUpdating = False
  'Check if invoice # is found on sheet "Sales"
  i = 2
  Do Until Sheets("Sales").Range("C" & i).Value = ""
    If Sheets("Sales").Range("C" & i).Value = Sheets("Invoice").Range("E3").Value Then
      'Ask overwrite invoice #?
      If MsgBox("Invoice Number Already Used- Do you want to copy over?", vbYesNo) = vbNo Then
        Exit Sub
      Else
        Exit Do
      End If
    End If
    i = i + 1
  Loop
  i = 1
  Set rng_dest = Sheets("Sales").Range("F:K")
  'Delete rows if invoice # is found
  Do Until Sheets("Sales").Range("C" & i).Value = ""
    If Sheets("Sales").Range("C" & i).Value = Sheets("Invoice").Range("E3").Value Then
      Sheets("Sales").Range("C" & i).EntireRow.Delete
      i = 1
    End If
    i = i + 2
  Loop
  ' Find first empty row in columns C:K on sheet Sales

    Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
    i = i + 1
  Loop
  'Copy range A8:E27 on sheet Invoice
  Set rng = Sheets("Invoice").Range("A7:F27")
  ' Copy rows containing values to sheet Sales
 For a = 2 To rng.Rows.count

    If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
      rng_dest.Rows(i).Value = rng.Rows(a).Value
      'Copy Invoice number
      Sheets("Sales").Range("C" & i).Value = Sheets("Invoice").Range("E3").Value
      'Copy Date
      Sheets("Sales").Range("D" & i).Value = Sheets("Invoice").Range("C3").Value
      'Copy Company name
      Sheets("Sales").Range("E" & i).Value = Sheets("Invoice").Range("C5").Value
      i = i + 1
    End If
  Next a
  Application.ScreenUpdating = True
End Sub

コードの終わり:

私の問題は、各請求書を保存すると、請求書のすべての空白行も表示されることです。

enter image description here

これを変更して、使用されている請求書の行だけが「販売」シートに表示されるようにする方法はありますか?

2
Jen

請求書の全範囲を使用する代わりに、データがあることがわかっている部分を使用してください。

With Sheets("Invoice")
    Dim lastRow as Long
    Dim rng as Range
    lastRow = .cells(.rows.count, 1).end(xlup).row
    Set rng = .Range(.Cells(8, 1), .Cells(lastRow, 6))
End With
1
Kyle