Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7804 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【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　　　　　　　　
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7804 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free