Excel VBA質問箱 IV

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

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


960 / 13645 ツリー ←次へ | 前へ→

【77258】シートをまとめる エクセル勉強中 15/6/27(土) 1:02 質問[未読]
【77259】Re:シートをまとめる β 15/6/27(土) 5:52 発言[未読]
【77260】Re:シートをまとめる kanabun 15/6/27(土) 11:26 発言[未読]
【77261】Re:シートをまとめる エクセル勉強中 15/6/27(土) 12:15 発言[未読]
【77262】Re:シートをまとめる kanabun 15/6/27(土) 14:07 発言[未読]
【77264】Re:シートをまとめる kanabun 15/6/27(土) 14:29 発言[未読]
【77266】Re:シートをまとめる エクセル勉強中 15/6/27(土) 15:21 発言[未読]
【77267】Re:シートをまとめる kanabun 15/6/27(土) 15:30 発言[未読]
【77265】Re:シートをまとめる β 15/6/27(土) 15:09 発言[未読]
【77263】Re:シートをまとめる kanabun 15/6/27(土) 14:22 発言[未読]

【77258】シートをまとめる
質問  エクセル勉強中 E-MAIL  - 15/6/27(土) 1:02 -

引用なし
パスワード
   1  A     B     C      D     E        F    G     H   I    J   
2 宴会名                                    
3 日付                                    
4 入力者                                    
5 備考                                    
6                                    
7                                    
8     部屋1    部屋2    部屋3    部屋4    部屋5    部屋6    部屋7    部屋8    部屋9
9 部屋名                                    
10 人  数                                    
11 宴席目的                                    
12 宴席形式                                    
13 開始時間                                    
14 終了時間                                    
15TOTAL                        137,250円            
16日付    コード    商品名    販売価格    出庫数    単位    合計    種類    部屋    備考
17    1015    アサヒ スーパードライ    800円    100    本    80,000円    ドリンク        
18    1016    サッポロ 黒ラベル    800円    55    本    44,000円    ドリンク        
19    1059    白岳仙    1,000円    3    合    3,000円    ドリンク        
20    1066    黒龍 純米吟醸    1,000円    4    合    4,000円    ドリンク        
21    1024    まるで梅酒なノンアルコール    450円    5    本    2,250円    ドリンク        
22    1055    一本義 上撰本醸造(赤)    1,000円    4    合    4,000円    ドリンク        
                                    
エクセル初心者です
この様なブックが月事に100ぐらい出来てきます((sheet1)しか記入されていない)
参考書を読むなりして1つのブックのシートにまとめる事はできたのですが、
その100枚のシートを一つのシートにまとめたい


まとめ方
範囲
列はA16からJ16
行はイフ関数の式が入っていてRange("c1").End(xlDown).Row←あえて(C1)では空白のセルで値の入っていないセルを最終行にかえしてしまう(if関数の式は114行まで入っているのでそこで止まってしまう)←ここがどう書けばいいか1番解らない
ので値の入った所までを範囲としたい
後は集計のシートに上から1つのシートごとにコピーしていく
A16行は見出しなのでコピーは不要
お手数ですがよろしくお願いします

【77259】Re:シートをまとめる
発言  β  - 15/6/27(土) 5:52 -

引用なし
パスワード
   ▼エクセル勉強中 さん:

C列のデータ最終行を取得する上でのヒントコードです。

Sub Test()
  MsgBox Range("C" & Rows.Count).End(xlUp).Row
  MsgBox Columns("C").Find(What:="*", LookAt:=xlWhole, LookIn:=xlValues, SearchDirection:=xlPrevious, After:=Range("C" & Rows.Count)).Row
End Sub

【77260】Re:シートをまとめる
発言  kanabun  - 15/6/27(土) 11:26 -

引用なし
パスワード
   ▼エクセル勉強中 さん:

> その100枚のシートを一つのシートにまとめたい


> まとめ方
> 範囲
> 列はA16からJ16

> A16行は見出しなのでコピーは不要

フィルタを使ってコピーする案です。

Sub tryA()
  With Range("C16", Cells(Rows.Count, "C").End(xlUp)) _
   .Offset(, -2).Resize(, 7)
     .Select        '確認用
     .AutoFilter Field:=3, Criteria1:="<>"
     If .Columns(1).SpecialCells(xlVisible).Count > 1 Then
       '確認用
       If MsgBox("Copyしますか?", vbOKCancel) = vbOK Then
         Intersect(.Cells, .Offset(1)).Select '確認用
         MsgBox "この範囲を別シートへコピーします"
       End If
     End If
     .AutoFilter
  End With
End Sub

でも、A列もB列も 114行まで 数式が入っているんですか?
どんな式でしょう?

【77261】Re:シートをまとめる
発言  エクセル勉強中 E-MAIL  - 15/6/27(土) 12:15 -

引用なし
パスワード
   ▼kanabun さん:
>▼エクセル勉強中 さん:
>
>>=IF(B22="","",VLOOKUP(B22,'C:\新しい伝票フォルダ\[伝票加藤10.xlsx]販売価格表'!$A$1:$K$2001,2,))
この様さ式が下まで入っています

【77262】Re:シートをまとめる
発言  kanabun  - 15/6/27(土) 14:07 -

引用なし
パスワード
   ▼エクセル勉強中 さん:

>>>=IF(B22="","",VLOOKUP(B22,'C:\新しい伝票フォルダ\[伝票加藤10.xlsx]販売価格表'!$A$1:$K$2001,2,))
>この様さ式が下まで入っています

C列はそのように 114行目まで数式がはいっています。
で、A列とか B列は そうではなく、上から手入力していて、たとえば、
↓の例ですと、[B23]から下は 空白セル(数式も入っていない) なのでは?

   A    B     C       D    E   F    G
16 日付  コード  商品名     価格 出庫数 単位  金額
17     1015   SuperDry    800   100  本  80000
18     1016   黒ラベル    800   55  本  44000
19     1059   白岳仙     1000    3  本  3000
20     1066   黒龍      1000    4  本  4000
21     1024   梅酒な     450    5  本  2250
22     1055   一本義     1000    4  本  4000
23          =If(B23="","",...)
24          =If(B24="","",...)
25          =If(B25="","",...)
:
:
114         =If(B114="","",...)

【77263】Re:シートをまとめる
発言  kanabun  - 15/6/27(土) 14:22 -

引用なし
パスワード
   AutoFilter案ですが、
もう少し具体例を示すと、
あるBookに 何十枚もの同じ形式のシートがあり、シートの1枚が「集約」という
名前のシートで、ここに他のシートのデータを集約するとすると、
こんな感じになります。

Sub tryAutoFilter()
 Dim wsまとめ As Worksheet
 Dim ws As Worksheet
 
 Set wsまとめ = Worksheets("集約") 'まとめ用シート
 For Each ws In Worksheets
  If ws.Name <> wsまとめ.Name Then
   With ws.Range("C16", ws.Cells(Rows.Count, "C").End(xlUp)) _
    .Offset(, -2).Resize(, 7)
      'データがある行だけを まとめ用シートに一括転記
      .AutoFilter Field:=3, Criteria1:="<>"
      If .Columns(1).SpecialCells(xlVisible).Count > 1 Then
          Intersect(.Cells, .Offset(1)).Copy _
         wsまとめ.Cells(Rows.Count, 2).End(xlUp).Offset(1, -1)
      End If
      .AutoFilter
   End With
  End If
 Next
End Sub

【77264】Re:シートをまとめる
発言  kanabun  - 15/6/27(土) 14:29 -

引用なし
パスワード
   >で、A列とか B列は そうではなく、上から手入力していて、たとえば、
>↓の例ですと、[B23]から下は 空白セル(数式も入っていない) なのでは?
>
>   A    B     C       D    E   F    G
>16 日付  コード  商品名     価格 出庫数 単位  金額
>17     1015   SuperDry    800   100  本  80000
>18     1016   黒ラベル    800   55  本  44000
>19     1059   白岳仙     1000    3  本  3000
>20     1066   黒龍      1000    4  本  4000
>21     1024   梅酒な     450    5  本  2250
>22     1055   一本義     1000    4  本  4000
>23          =If(B23="","",...)
>24          =If(B24="","",...)
>25          =If(B25="","",...)
> :
> :
>114         =If(B114="","",...)

B列に着目すれば、値が入っている行だけを直接コピーしてしまえばよいので
簡単です。

Sub tryB()
 Dim wsまとめ As Worksheet
 Dim ws As Worksheet
 
 Set wsまとめ = Worksheets("集約") 'まとめ用シート
 For Each ws In Worksheets
  If ws.Name <> wsまとめ.Name Then
    ws.Range("B17", ws.Cells(Rows.Count, 2).End(xlUp)) _
     .Offset(, -1).Resize(, 7).Copy
    wsまとめ.Cells(Rows.Count, 2).End(xlUp).Offset(1, -1) _
     .PasteSpecial xlPasteValues
  End If
 Next

End Sub

【77265】Re:シートをまとめる
発言  β  - 15/6/27(土) 15:09 -

引用なし
パスワード
   ▼エクセル勉強中 さん:

コピー先ブックの状態のみならず、コピー元ブックの状態、
特にそこにある式がコピペでOKなものなのかどうか不透明な部分が少なくないのですが
とりあえず。

DeskTopにあるエクセルブックを読みこみ、各ブックの最初のシートのデータを
マクロブックの最初のシートにコピペします。

Sub Test集約()
  Dim fPath As String
  Dim fName As String
  Dim fSh As Worksheet
  Dim tSh As Worksheet
  Dim z As Long
  
  Application.ScreenUpdating = False
  
  Set tSh = ThisWorkbook.Sheets(1)
  fPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\Test\"
  
  fName = Dir(fPath & "*.xls*")
  
  Do While fName <> ""
    If fName <> ThisWorkbook.Name Then '念のため
      Set fSh = Workbooks.Open(fPath & fName).Sheets(1)
      z = fSh.Columns("C").Find(What:="*", LookAt:=xlWhole, LookIn:=xlValues, SearchDirection:=xlPrevious, After:=fSh.Range("C" & Rows.Count)).Row
      If z > 17 Then
        Range("A17:J" & z).Copy tSh.Range("C" & Rows.Count).End(xlUp).Offset(1).Offset(, -2)
      End If
      fSh.Parent.Close False
    End If
    fName = Dir()
  Loop
    
End Sub

【77266】Re:シートをまとめる
発言  エクセル勉強中  - 15/6/27(土) 15:21 -

引用なし
パスワード
   おっしゃる通りA列B列には式は入ってないのですが、
コードが無く直接商品名を手入力する場合がありますのでc列のところから最終行を求めたいです
ちなみにA列の日付のところは直接手入力で打ち込んでいます。

【77267】Re:シートをまとめる
発言  kanabun  - 15/6/27(土) 15:30 -

引用なし
パスワード
   ▼エクセル勉強中 さん:

>ちなみにA列の日付のところは直接手入力で打ち込んでいます。

A列データがある行だけ、なら、先ほどの tryB() のほうは
こんな感じになります。

Sub tryB()
 Dim wsまとめ As Worksheet
 Dim ws As Worksheet
 
 Set wsまとめ = Worksheets("集約") 'まとめ用シート
 For Each ws In Worksheets
  If ws.Name <> wsまとめ.Name Then
    ws.Range("A17", ws.Cells(Rows.Count, 1).End(xlUp)).Resize(, 7).Copy
    wsまとめ.Cells(Rows.Count, 2).End(xlUp).Offset(1, -1) _
     .PasteSpecial xlPasteValues
  End If
 Next

End Sub

なお、このコードは 同じBookのなかに 集約用のシートが1枚入っていて、
1行目に、列見出しが

   A    B     C       D    E   F    G
1  日付  コード  商品名     価格 出庫数 単位  金額

のように書き込んであることを仮定しています。
また、その集約用シート名は ここでは「集約」としています。

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