[[20120222113042]]　『複数シートのセル抽出③』（n）　ページの最後に飛ぶ

『複数シートのセル抽出③』（n）

 お世話になっております。初心者のままです。
 個別シートの見積書の内容をデータ一覧として別シートにまとめる方法で
 また教えていただけたら幸いです。②で案をいただいているもう一つの方法です。

 Sheet1	[A]    [B]   [C]    [D]    [F]    [H]    [I]    [J]    [K]    [L]
 [ 5]		    				          №1
 [ 6]						  2/21  	
 [ 8]	A商店			    				
 [ 9]	○○様			    				
 [19]	      みかん       愛媛産 △農園 100個 100円　		
 [20]          りんご       青森産 □農園 200個 200円		
 [21]								
  :　								
 [28]
 [29]                注意書きA　          
 [30]                                                                 送料1000円
 [32]                注文番号A22
 [33]　　　　　　　　支払期日3/21　　　
 [34]　　　　　　　　納期2/23

 Sheet2	[A]    [B]    [C]    [D]    [F]    [H]    [I]    [J]    [K]    [L]
 [ 5]		    				           №2
 [ 6]						   2/22  	
 [ 8]	B商店			    				
 [ 9]    ××様		    				
 [19]	       いちご        栃木産 ▽農園  50個 50円　		
 [20]           				
 [21]								
  :				
 [28]
 [29]                注意書きB　          
 [30]                                                                  送料500円
 [32]                注文番号A23
 [33]　　　　　　　　支払期日3/22　　　
 [34]　　　　　　　　納期2/24

 データ一覧
 　 [A] [B]  [C]  [D]   [E]   [F]   [G]   [H]  [I]  [J]  [K] [L]     [M]   [N]
 [1] № 日付 会社 担当  商品  産地  農園  個数 単価 注意 送料注文番号支払 納期  
 [2] 1  2/21 A商店○○様みかん愛媛産△農園100個100円注意A1000円A22  3/21  2/23
 [3] 1  2/21 A商店○○様りんご青森産□農園200個200円注意A1000円A22  3/21  2/23
 [4] 2  2/22 B商店××様いちご栃木産▽農園 50個50円 注意B 500円A23  3/22  2/24

 各シートのB列商品、D列産地、F列農園、H列個数、I列単価までと、
 行が19行目から28行目 までの表部分で
 10商品は見積もれる形になっていますが、
 ほとんどのシートが10行目までフル使用することがありません。
 そのため、データ一覧のように、各シートの表の空白の行は
 詰めてしまいたいと思っています。

 このやり方でも抽出できるのでしたら
 ぜひ教えていただけないでしょうか。

[[20120209133706]]『複数シートのセル抽出②』

 取り敢えず
 No　  L5　、　日付　K6　、　向先　A8　、　担当　A9
 ってのは分かるので（あってますよね？）
 その他の項目がどのセルに入っているか教えて下さい。

 (HANA)

 HANAさん、引き続きありがとうございます。表がずれているようです。すみません。

 K5:№、J6：日付、A8:向先、A9：担当、
 B19からB28：商品、D19からD28：産地、F19からF28:農園、H19からH28：個数、I19からI28；単価、
 C29：注意書き、L30：送料、C32：注文№、C33：支払期日、C34：納期
 になります。
 ありがとうございます。(n)

 こんな感じで。。。？

 '------
Sub Test2()
Dim MyShi As Worksheet
Dim MyRow As Long, MyCnt As Long
Dim i As Long

    With Worksheets("D") '←データをまとめるシート名に変更
        Application.ScreenUpdating = False
        .Range("2:" & Rows.Count).ClearContents
        MyRow = 1
        For Each MyShi In Worksheets
            If MyShi.Name <> .Name Then
                If MyShi.Range("A8").Value <> "" Then
                    MyRow = MyRow + 1
                    .Range("A" & MyRow).Value = MyShi.Range("K5").Value     'No
                        '===↓ハイパーリンクの設定===
                    .Hyperlinks.Add Anchor:=.Range("A" & MyRow), _
                        Address:="", SubAddress:=MyShi.Name & "!A1"
                        '===↑ハイパーリンクの設定===
                    .Range("B" & MyRow).Value = MyShi.Range("J6").Value     '日付
                    .Range("C" & MyRow).Value = MyShi.Range("A8").Value     '会社
                    .Range("D" & MyRow).Value = MyShi.Range("A9").Value     '担当

                    .Range("J" & MyRow).Value = MyShi.Range("C29").Value    '注意
                    .Range("K" & MyRow).Value = MyShi.Range("L30").Value    '送料
                    .Range("L" & MyRow).Value = MyShi.Range("C32").Value    '注文番号
                    .Range("M" & MyRow).Value = MyShi.Range("C33").Value    '支払
                    .Range("N" & MyRow).Value = MyShi.Range("C34").Value    '納期

                    For i = 19 To 28
                        If MyShi.Range("B" & i).Value <> "" Then
                            MyCnt = MyCnt + 1
                        End If
                    Next

                    If MyCnt > 0 Then
                        .Range("A" & MyRow & ":N" & MyRow + MyCnt - 1).Value = .Range("A" & MyRow & ":N" & MyRow).Value
                        .Range("E" & MyRow).Resize(MyCnt).Value = MyShi.Range("B19").Resize(MyCnt).Value        '商品
                        .Range("F" & MyRow).Resize(MyCnt).Value = MyShi.Range("D19").Resize(MyCnt).Value        '産地
                        .Range("G" & MyRow).Resize(MyCnt).Value = MyShi.Range("F19").Resize(MyCnt).Value        '農園
                        .Range("H" & MyRow).Resize(MyCnt, 2).Value = MyShi.Range("H19").Resize(MyCnt, 2).Value  '個数,単価

                        MyRow = MyRow + MyCnt - 1
                        MyCnt = 0
                    End If
                End If
            End If
        Next
        Application.Goto .Range("A1"), True
        Application.ScreenUpdating = True
    End With
End Sub
 '------

 (HANA)

 HANAさん、うまくできました！
 ありがとうございます。
 感謝します。
(n)

コメント返信：

[ 一覧(最新更新順) ]

[[20120222113042]] 『複数シートのセル抽出③』（n） ページの最後に飛ぶ

[[20120222113042]]　『複数シートのセル抽出③』（n）　ページの最後に飛ぶ