Excel VBA質問箱 IV

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

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


67698 / 76732 ←次へ | 前へ→

【13588】検索したデータを特定のシートへ貼り付ける
質問  ハルコ  - 04/5/8(土) 15:29 -

引用なし
パスワード
   みなさん、こんにちは。以前にも私の質問に対して、快くご回答していただいた方ありがとうございました。また今回も分からないことがあり、投稿させていただきました。標題のとおり、検索したデータを特定のシートへ貼り付ける、という作業なのですが、考えているとおり、うまくいきません。具体的には、次のとおりの作業で、その次に考えたコードをのせています。もちろん、このコードでは何ら反応しません。まだ、初心者で四苦八苦しながらやっているのですが、どうしてもわからいので、どうかお力を貸してください。宜しくお願いします。

1.シート1にデータがあります。データの内容は次のとおりです。
 これらのデータは毎日、シート1へ貼り付けられます。
 従いまして、B列の日付けデータ・A列の店名・B〜G列の数字は
 毎日、違います。又、グループ数(各日にちのデータをいいます)も違います。 ちなみに、1・2行は文字列が入っていますので省略させていただきます。
  A  B    C   D  E   F    G 
1   
2
3    20040401
4    貸分      借分    貸借合計
5    件数   金額  件数 金額  件数  金額
6 A店 2    1,000 5  6,500 7    7,500
7 B店 3    2,000 3  2,000 6    4,000
8 合計 5    3,000 8  8,500 13    11,500
9    20040402
10   貸分      借分    貸借合計
11 A店 1    1,000 5  6,500 6    7,500
12 D店 3    2,000 3  2,000 6    4,000
13 G店 2    1,000 5  6,500 7    7,500
14 合計 6    4,000 13  15,000 19    19,000
15           ・
16           ・

2.D列の借分の件数・金額を、B列の日付データを検索条件として、1日〜31日分のシートにある表のセルE1と合致するシートを検索し、貼り付けます。店数は全部で33店あります。
 その表は以下のとおりです。
(4月1日分の場合)
 B   E    Q   R
1   20040401
2
3
4        件数 金額
5 A店
6 B店 
7 C店
8 D店
9 E店
10 F店
 ・
 ・
37 AG店

3.モジュールです。この内容では、セルB3の日付分のデータだけしか検索することができません。これをシート1のB列の全ての日付分のデータを検索し、対象となる日付シートへ貼り付けたいのです。なお、前述でもふれましたが、店数が多いことから、以下のようなコードですと、かなりのコードを入力しなくてはなりません。
このことから、もっと省略できるようなコードがありましたら、併せて、ご教授をお願いいたします。

Sub 日計表へ移行()

  Dim i As Integer
  Dim 行番号 As Long
  Dim 列番号 As Long
  Dim 選択シート() As Variant
  Dim 検索文字 As String
  Dim 合致セル As Range
  Dim 日付 As Range

  Application.ScreenUpdating = false

  Worksheets("シート1").Select
  
'グループ1.について日計表へ移行させる。

  ReDim 選択シート(31)
  検索文字 = Range("B3").Value

’シートを検索する。  
  For i = 5 To 35
    Set 合致セル = Worksheets(i).Cells(1, 5).Find(検索文字,    
       LookIn:=xlValues, lookat:=xlPart)
    If Not 合致セル Is Nothing Then
      If 選択シート(1) = "" Then
        選択シート(1) = i
      End If
    End If
  Next i
’当月分のデータではない時、メッセージをだす。      
  If 選択シート(1) = "" Then
    MsgBox "グループ1.については、他の月の分です。"
  
  Else
    行番号 = 3
    列番号 = 1
    
    For 行番号 = 3 To 65536 Step 1
      If Cells(行番号, 列番号) = "" And Cells(行番号, 列番号 + 1)  
= "" Then
        Exit For
      End If
    
      If Cells(行番号, 列番号) = "A店" Then
        Cells(行番号, 列番号 + 3).Copy
        Worksheets(選択シート(1)).Select
        Range("Q5").PasteSpecial   OPERATION:=xlPasteSpecialOperationAdd, _
          Paste:=xlPasteValues
        Application.CutCopyMode = False
        
        Worksheets("シート1").Select
        Cells(行番号, 列番号 + 4).Copy
        Worksheets(選択シート(1)).Select
        Range("R5").PasteSpecial OPERATION:=xlPasteSpecialOperationAdd, _
          Paste:=xlPasteValues
        Application.CutCopyMode = False
      
      ElseIf Cells(行番号, 列番号) = "B支店" Then
        Worksheets("シート1").Select
        Cells(行番号, 列番号 + 3).Copy
        Worksheets(選択シート(1)).Select
        Range("Q6").PasteSpecial OPERATION:=xlPasteSpecialOperationAdd, _
          Paste:=xlPasteValues
        Application.CutCopyMode = False
        
        Worksheets("シート1").Select
        Cells(行番号, 列番号 + 4).Copy
        Worksheets(選択シート(1)).Select
        Range("R6").PasteSpecial OPERATION:=xlPasteSpecialOperationAdd, _
          Paste:=xlPasteValues
        Application.CutCopyMode = False    
      End If
    Next  
  End If    
  Application.ScreenUpdating = True  
End Sub
2 hits

【13588】検索したデータを特定のシートへ貼り付ける ハルコ 04/5/8(土) 15:29 質問
【13597】Re:検索したデータを特定のシートへ貼り付... Hirofumi 04/5/9(日) 11:39 回答
【13608】Re:検索したデータを特定のシートへ貼り付... ハルコ 04/5/9(日) 16:20 質問
【13613】Re:検索したデータを特定のシートへ貼り付... Hirofumi 04/5/9(日) 18:23 回答
【13617】Re:検索したデータを特定のシートへ貼り付... ハルコ 04/5/9(日) 20:02 質問
【13618】Re:検索したデータを特定のシートへ貼り付... Hirofumi 04/5/9(日) 20:44 回答
【13620】Re:検索したデータを特定のシートへ貼り付... ハルコ 04/5/9(日) 21:21 質問
【13664】Re:検索したデータを特定のシートへ貼り付... Hirofumi 04/5/10(月) 20:06 回答
【13666】Re:検索したデータを特定のシートへ貼り付... ハルコ 04/5/10(月) 21:24 質問
【13668】Re:検索したデータを特定のシートへ貼り付... Hirofumi 04/5/10(月) 21:48 回答
【13669】Re:検索したデータを特定のシートへ貼り付... ハルコ 04/5/10(月) 23:12 質問
【13719】Re:検索したデータを特定のシートへ貼り付... Hirofumi 04/5/11(火) 20:18 回答
【13721】Re:検索したデータを特定のシートへ貼り付... Hirofumi 04/5/11(火) 21:10 回答
【13722】Re:検索したデータを特定のシートへ貼り付... ハルコ 04/5/11(火) 22:24 質問
【13755】Re:検索したデータを特定のシートへ貼り付... Hirofumi 04/5/12(水) 19:50 回答
【13760】Re:検索したデータを特定のシートへ貼り付... ハルコ 04/5/12(水) 22:17 質問
【13801】Re:検索したデータを特定のシートへ貼り付... Hirofumi 04/5/13(木) 21:49 回答
【13845】Re:検索したデータを特定のシートへ貼り付... ハルコ 04/5/15(土) 1:31 質問
【13849】Re:検索したデータを特定のシートへ貼り付... Hirofumi 04/5/15(土) 7:31 回答
【13889】Re:検索したデータを特定のシートへ貼り付... ハルコ 04/5/15(土) 19:20 質問
【13895】Re:検索したデータを特定のシートへ貼り付... Hirofumi 04/5/15(土) 20:56 回答
【13900】Re:検索したデータを特定のシートへ貼り付... ハルコ 04/5/15(土) 23:29 質問
【13901】Re:検索したデータを特定のシートへ貼り付... ハルコ 04/5/16(日) 0:23 質問
【13903】Re:検索したデータを特定のシートへ貼り付... Hirofumi 04/5/16(日) 1:45 回答
【13909】Re:検索したデータを特定のシートへ貼り付... ハルコ 04/5/16(日) 19:07 質問
【13910】Re:検索したデータを特定のシートへ貼り付... Hirofumi 04/5/16(日) 21:07 回答
【13911】Re:検索したデータを特定のシートへ貼り付... ハルコ 04/5/16(日) 22:48 お礼

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