Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
980 / 13665 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【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枚のシートを一つのシートにまとめたい


まとめ方
範囲
列はＡ16からＪ16
行はイフ関数の式が入っていてRange("ｃ1").End(xlDown).Row←あえて（Ｃ1）では空白のセルで値の入っていないセルを最終行にかえしてしまう（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枚のシートを一つのシートにまとめたい


> まとめ方
> 範囲
> 列はＡ16からＪ16

> 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行目まで数式がはいっています。
で、Ａ列とか 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 -
引用なし
パスワード
   >で、Ａ列とか 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 -
引用なし
パスワード
   ▼エクセル勉強中 さん：

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

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 -
引用なし
パスワード
   おっしゃる通りＡ列Ｂ列には式は入ってないのですが、
コードが無く直接商品名を手入力する場合がありますのでｃ列のところから最終行を求めたいです
ちなみにＡ列の日付のところは直接手入力で打ち込んでいます。
【77267】Re:シートをまとめる
発言  kanabun  - 15/6/27(土) 15:30 -
引用なし
パスワード
   ▼エクセル勉強中 さん：

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

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 　日付　　コード　 商品名　　　　 価格　出庫数　単位　 金額

のように書き込んであることを仮定しています。
また、その集約用シート名は ここでは「集約」としています。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
980 / 13665 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free