Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7803 / 13644 ツリー ←次へ | 前へ→

【36776】請求書シートを別のシートへコピーする かずみ 06/4/13(木) 15:40 質問[未読]
【36777】Re:請求書シートを別のシートへコピーする Statis 06/4/13(木) 16:06 発言[未読]
【36780】Re:請求書シートを別のシートへコピーする かずみ 06/4/13(木) 16:19 質問[未読]
【36782】Re:請求書シートを別のシートへコピーする Statis 06/4/13(木) 16:40 回答[未読]
【36783】Re:請求書シートを別のシートへコピーする Kein 06/4/13(木) 17:14 回答[未読]

【36776】請求書シートを別のシートへコピーする
質問  かずみ  - 06/4/13(木) 15:40 -

引用なし
パスワード
   はじめまして。初心者です。請求書作成後、数値を別のシート(売り上げ表)に入力して、その後、また別の顧客の請求書を作成して、売り上げ表に数値を追加入力していきたいのですが、どのような手順をとればいいですか。
請求書シート                 売り上げ表
A(商品番号)B(数量)C(顧客番号)  A(顧客番号) B(商品番号) C(数量)
101      2    I2            I2      101   2
102      3    I2                   102   3
105      4    I2                   105   4

                    >>   I4      101   1
A(商品番号) B    C(顧客番号)             103   4  
101      1    I4                   106   6 
103      4    I4
106      6    I4 

実は、大学のVBAのクラスの課題となってます。別のシートへコピーする方法はわかるのですが、売り上げ表にコピーするたびに新しい入力が加わっていく方法が判らなくて困って増す。宜しくおねがいします。

【36777】Re:請求書シートを別のシートへコピーする
発言  Statis  - 06/4/13(木) 16:06 -

引用なし
パスワード
   こんにちは
請求シートの記載ですが?
売り上げ表に転記してから一度データをクリアして再度記載するのでしょうか?
それとも同じようなデータが下へ無数に出来るのでしょうか?

【36780】Re:請求書シートを別のシートへコピーする
質問  かずみ  - 06/4/13(木) 16:19 -

引用なし
パスワード
   ▼Statis さん:
>こんにちは
>請求シートの記載ですが?
>売り上げ表に転記してから一度データをクリアして再度記載するのでしょうか?
>それとも同じようなデータが下へ無数に出来るのでしょうか?

売り上げ表に転記後、請求書シートは一度クリアにします。その後、他の顧客のデータを請求書シートへ入力して、再度売り上げ表にデータを下へ無数に入力していく方法です。

宜しくお願いします。

かずみ

【36782】Re:請求書シートを別のシートへコピーする
回答  Statis  - 06/4/13(木) 16:40 -

引用なし
パスワード
   こんにちは

これで如何かな?
コードの説明はヘルプなど見て調べてください。
シート名はそちらの環境に合わせてください。

Sub Test()
Dim Da As Variant, Da1 As String

With Worksheets("請求書")
   Da1 = .Range("C2").Value
   With .Range("A2", .Range("A65536").End(xlUp))
      Da = .Resize(, 2).Value
     .Resize(, 3).ClearContents
   End With
End With
With Worksheets("売り上げ表").Range("B65536").End(xlUp)
   If .Row = 1 Then
    .Offset(1).Resize(UBound(Da), 2).Value = Da
    .Offset(1, -1).Value = Da1
   Else
    .Offset(2).Resize(UBound(Da), 2).Value = Da
    .Offset(2, -1).Value = Da1
   End If
End With

End Sub

【36783】Re:請求書シートを別のシートへコピーする
回答  Kein  - 06/4/13(木) 17:14 -

引用なし
パスワード
   未テストですが・・

Sub Test_My集計()
  Dim Sh1 As Worksheet, Sh2 As Worksheet
  Dim Fv As Variant
  Dim MyR As Range, FR As Range, C As Range
  Dim LstR As Long

  Set Sh1 = Worksheets("請求書")
  Set Sh2 = Worksheets("売り上げ表")
  If IsEmpty(Sh1.Range("A2").Value) Then GoTo LLine
  For Each C In Sh1.Range("A2", Sh1.Range("A65536").End(xlUp))
   Fv = Application _
   .Match(C.Offset(, 2).Value, Sh2.Range("A:A"), 0)
   If IsError(Fv) Then
     If IsEmpty(Sh2.Cells(2, 1).Value) Then
      Fv = 2
     Else
      Fv = Sh2.Cells(65536, 1).End(xlUp).Offset(500).Row
     End If
     Sh2.Cells(Fv, 1).Value = C.Offset(, 2).Value
     Sh2.Cells(Fv, 2).Value = C.Value
     Sh2.Cells(Fv, 3).Value = C.Offset(, 1).Value
   Else
     LstR = Sh2.Cells(Fv, 1).End(xlDown).Row - 1
     Set MyR = _
     Sh2.Range(Sh2.Cells(Fv, 1), Sh2.Cells(LstR, 1)).Offset(, 1)
     Set FR = MyR.Find(C.Value, , xlValues, xlWhole)
     If FR Is Nothing Then
      If IsEmpty(Sh2.Cells(Fv, 2).Value) Then
        Sh2.Cells(Fv, 2).Value = C.Value
        Sh2.Cells(Fv, 3).Value = C.Offset(, 1).Value
      Else
        With Sh2.Cells(LstR, 2).End(xlUp)
         .Offset(1).Value = C.Value
         .Offset(1, 1).Value = C.Offset(, 1).Value
        End With
      End If
     Else
      FR.Offset(, 1).Value = _
      FR.Offset(, 1).Value + C.Offset(, 1).Value
      Set FR = Nothing
     End If
     Set MyR = Nothing
   End If
  Next
LLine:
  Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub        

7803 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free