[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『スナックの費用データをまとめたいのです』（Ｙｕｒｉｋｏ．ｍ）
エクセル2010を使用しています。
スナックのママをしています。
Ｆ列10行目から、スナックでかかった日付別費用のシート名(12月1日乾き物‥)をＦ列に並べました。50ほどのシート数になりそうです。
このシートの、おのおののＺ10からＡＱ250(実際は最大でもＡＱ50ほどしか行数はいきませんが、念のため多く行数をとりました)のデータを、
シート名 累積台帳 のМ10からＡＤに連続して値のみコピペしたいのです。
ただし、おのおののシートのデータでＺ(日付の項目です)が空白のものは、除いて、コピペしたいのです。
手動コピペをどうにかしないで(失敗するので)、自動で処理する方法をやさしくご教授くださいませ。
シートの名前 累積台帳
Ｆ М …… ＡＤ
9 月日科目 12月1日
10 12月1日乾き物
11 12月1日アルコールＡ
12 12月2日材料Ａ
13 12月3日材料Ｂ
14 12月3日アルコールＣ
15 12月3日材料Ｃ
＜ 使用 Excel：unknown、使用 OS：unknown ＞
＞このシートの、おのおののＺ10からＡＱ250 ＞(実際は最大でもＡＱ50ほどしか行数はいきませんが、念のため多く行数をとりました)のデータを、 ＞シート名 累積台帳のМ10からＡＤに連続して値のみコピペしたいのです。
ちょっと分からないです。
各シートに付き、Ｚ10からＡＱ250のデータだと、約240行ｘ20列程度のデータですよね。
一方、貼り付け先は、1シート分、1行x20列ですよね。
240行を1行にコピペするなんて無理じゃないですか？
（半平太） 2017/12/11(月) 23:04
具体的に言うと、
Ｚ10のデータ を M10に AA10のデータ を、N10にと言う具合です。 各シートの数が50ほどで、各シートの行数が40ほどなので、
累積台帳の表は、M10からAD2000ほどまでの、2000行ほどになる計算になります。
半平太さま、よろしくお願いいたします。。
（Ｙuriko.m） 2017/12/12(火) 08:40
＜マクロの貼り付け方＞ 目的のシートの「シート見出し」を右クリックして、「コードの表示(V)」を選ぶと 画面中央に白いエリアが表れます。(VBE画面です）
その白いエリアに後記マクロを貼り付けたら、Alt+F11でエクセルに戻れば、準備完了です。
＜使い方＞ F9セル(月日科目)を右クリックすると自動的に以下の表が出来ます。(注：ダブルクリックじゃないです）
(1) F列 : 全ての「*月*日品名」となっているシート名 (2) M列〜AQ列 : 全てのデータ(ただし、日付データのあるもの)
※各シートのデータの間に、2行空白を入れてあります。(区切りがある方が見やすいと思ったので）
＜貼り付けるマクロ＞
’ ↓
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Wsh As Worksheet
Dim Rw As Long
If Target.Address <> "$F$9" Then
Exit Sub
Else
Cancel = True
End If
Range("F10:F10000,M10:AQ10000").ClearContents
Application.ScreenUpdating = False
Rw = 9
For Each Wsh In ThisWorkbook.Sheets
If Wsh.Name Like "*月*日*" Then
Rw = Rw + 1
Cells(Rw, "F").Value = Wsh.Name
Call MonthlyCpPs(Wsh)
End If
Next
Range("F:AD").EntireColumn.AutoFit
Range("F9").Select
Application.ScreenUpdating = True
End Sub
Private Sub MonthlyCpPs(ByRef Wsh As Worksheet) '１シートの処理
Dim lastRWsrc As Long
Dim lastRWdst As Long
Dim firstCel As Range
Dim TgtRng As Range
With Wsh
lastRWsrc = Application.Max(10, .Cells(.Rows.Count, "Z").End(xlUp).Row)
lastRWdst = Application.Max(10, Cells(.Rows.Count, "M").End(xlUp).Row)
.Range("Z10:AQ" & lastRWsrc).Copy
End With
Set firstCel = Range("M" & lastRWdst + IIf(lastRWdst = 10, 0, 3)) '貼り付け先の先頭セル
firstCel.PasteSpecial xlPasteValuesAndNumberFormats
If Application.CountBlank(firstCel.Resize(lastRWsrc - 9)) Then 'Ｚ列に空白があれば
Set TgtRng = firstCel.Resize(lastRWsrc - 9, 1).SpecialCells(xlCellTypeBlanks)
Intersect(TgtRng.EntireRow, Columns("M:AD")).Delete Shift:=xlUp
End If
End Sub
（半平太） 2017/12/12(火) 10:46
（Ｙuriko.m） 2017/12/12(火) 14:44
サンプルデータとして、後記2シート分あると仮定すると、 実行結果図は以下となりますが、そちらは一体どんなデータなんですか？
<結果図> 行 _________F_________ L ___M___ _N_ _O_ _P_ _Q_ _R_ _S_ _T_ _U_ _V_ _W_ _X_ _Y_ _Z_ _AA_ _AB_ _AC_ ___AD___ 9 月日科目 日付欄 10 12月1日乾き物 12月2日 z11 z11 z13 z14 z15 z16 z17 z18 z19 z20 z21 z22 z23 z24 z25 z26 AQ乾1-2 11 12月1日アルコールＡ 12月3日 z11 z12 z13 z14 z15 z16 z17 z18 z19 z20 z21 z22 z23 z24 z25 z26 AQ乾1-3 12 12月5日 z11 z12 z13 z14 z15 z16 z17 z18 z19 z20 z21 z22 z23 z24 z25 z26 AQ乾1-5 13 14 15 12月1日 z11 z12 z13 z14 z15 z16 z17 z18 z19 z20 z21 z22 z23 z24 z25 z26 AQ乾AL-1 16 12月1日 z11 z12 z13 z14 z15 z16 z17 z18 z19 z20 z21 z22 z23 z24 z25 z26 AQ乾AL-4
<12月1日乾き物> シートのサンプル 行 __ Z __ _AA_ _AB_ _AC_ _AD_ _AE_ _AF_ _AG_ _AH_ _AI_ _AJ_ _AK_ _AL_ _AM_ _AN_ _AO_ _AP_ ___AQ___ 10 z11 z10 z13 z14 z15 z16 z17 z18 z19 z20 z21 z22 z23 z24 z25 z26 AQ乾1-1 11 12月2日 z11 z11 z13 z14 z15 z16 z17 z18 z19 z20 z21 z22 z23 z24 z25 z26 AQ乾1-2 12 12月3日 z11 z12 z13 z14 z15 z16 z17 z18 z19 z20 z21 z22 z23 z24 z25 z26 AQ乾1-3 13 z11 z12 z13 z14 z15 z16 z17 z18 z19 z20 z21 z22 z23 z24 z25 z26 AQ乾1-4 14 12月5日 z11 z12 z13 z14 z15 z16 z17 z18 z19 z20 z21 z22 z23 z24 z25 z26 AQ乾1-5
<12月1日アルコールＡ> シートのサンプル 行 __ Z __ _AA_ _AB_ _AC_ _AD_ _AE_ _AF_ _AG_ _AH_ _AI_ _AJ_ _AK_ _AL_ _AM_ _AN_ _AO_ _AP_ ___AQ___ 10 12月1日 z11 z12 z13 z14 z15 z16 z17 z18 z19 z20 z21 z22 z23 z24 z25 z26 AQ乾AL-1 11 z11 z12 z13 z14 z15 z16 z17 z18 z19 z20 z21 z22 z23 z24 z25 z26 AQ乾AL-2 12 z11 z12 z13 z14 z15 z16 z17 z18 z19 z20 z21 z22 z23 z24 z25 z26 AQ乾AL-3 13 12月1日 z11 z12 z13 z14 z15 z16 z17 z18 z19 z20 z21 z22 z23 z24 z25 z26 AQ乾AL-4 14 z11 z12 z13 z14 z15 z16 z17 z18 z19 z20 z21 z22 z23 z24 z25 z26 AQ乾AL-5
（半平太） 2017/12/12(火) 15:02
シート
12月1日乾き物
行 __ Z __ _ AA_ _ AB_ _ AC_ _割愛 AG_ _ _AI_ _AJ_ _割愛 ___AQ___
9 年月 コード 商品Ａ 商品Ｂ 価格 管理番号
10 12月1日 1054 ポテチ カルビー 108
11 合計 108
12 12月1日 1025 ナッツ アメリカ21 56
13 12月1日 1025 ナッツ アメリカ21 56
14 12月1日 1025 ナッツ アメリカ21 56
15 合計 168
16 12月1日 1032 するめ 海鮮 140
17 12月1日 1032 するめ 海鮮 140
18 合計 280
（Ｙｕｒｉｋｏ．ｍ） 2017/12/12(火) 19:50
＞各コードの次の行のAIに、合計という文字を、AJに金額合計
合計行が邪魔なんですね？
そうなると、累計の方も空白を２行入れる必要は無かったですね。
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Wsh As Worksheet
Dim Rw As Long
If Target.Address <> "$F$9" Then
Exit Sub
Else
Cancel = True
End If
Range("F10:F10000,M10:AQ10000").ClearContents
Application.ScreenUpdating = False
Rw = 9
For Each Wsh In ThisWorkbook.Sheets
If Wsh.Name Like "*月*日*" Then
Rw = Rw + 1
Cells(Rw, "F").Value = Wsh.Name
Call MonthlyCpPs(Wsh)
End If
Next
Range("F:AD").EntireColumn.AutoFit
Range("F9").Select
Application.ScreenUpdating = True
End Sub
Private Sub MonthlyCpPs(ByRef Wsh As Worksheet) '１シートの処理
Dim lastRWsrc As Long
Dim lastRWdst As Long
Dim firstCel As Range
Dim TgtRng As Range
With Wsh
lastRWsrc = Application.Max(10, .Cells(.Rows.Count, "Z").End(xlUp).Row)
lastRWdst = Application.Max(9, Cells(.Rows.Count, "M").End(xlUp).Row)
.Range("Z10:AQ" & lastRWsrc).Copy
End With
Set firstCel = Range("M" & lastRWdst + 1) '貼り付け先の先頭セル
firstCel.PasteSpecial xlPasteValuesAndNumberFormats
On Error Resume Next
Set TgtRng = firstCel.Offset(, 9).Resize(lastRWsrc, 1).SpecialCells(xlCellTypeConstants, 23)
On Error GoTo 0
If Not TgtRng Is Nothing Then
Intersect(TgtRng.EntireRow, Columns("M:AD")).Delete Shift:=xlUp
End If
End Sub
（半平太） 2017/12/12(火) 22:56
「12月1日乾き物」のレイアウトと 「12月1日アルコールＡ」以降のレイアウトは本当に同じなんですか？
（半平太） 2017/12/13(水) 10:32
（Ｙuriko.m） 2017/12/13(水) 10:46
試しにですが・・・
「12月1日乾き物」のシート見出しをクリックし、 Ctrlキーを押しながら、シート見出しをマウスでつかんで右へドラッグすると 「12月1日乾き物(2)」と言うシートが追加されます。
その状態で、「累積シートのF9セルを右クリック」するとどうなりますか？ 相変わらず、１シート分だけしかコピーされないですか？
（半平太） 2017/12/13(水) 12:15
＞乾き物のデータ数は6行、アルコールAの行数は、21行あります。
＞見出しには乾き物（2）が出ましたが、 ＞やはりコピペされたのは、最初からある、乾き物シートの6行のみでした。
１．・・・と言うことは「乾きもの」シートのAI列には「合計」と言うデータは無いですね？
２．「乾き物(2)」シートのどこか空いているセルに以下の数式を入れて、どんな値が返るか教えてください。
="Z列"&COUNTA(Z10:Z100)&"件、AI列の合計"&COUNTIF(AI10:AI100,"合計")&"件、AJ列の数値"&COUNT(AJ10:AJ100)&"件"
回答例: Z列6件、AI列の合計0件、AJ列の数値0件
（半平太） 2017/12/13(水) 13:49
2. 入れたのですが、そのままの文字列のままでした。
counta関数で調べたところ、Ｚは90件、ほかは3件、3件となりました。
たぶんＺ列が90件なのは、
AAにコードが入ると、年月が入るように関数が入っているから？
ほかにも、そういう箇所があります。
Ｚ10の行は必ずデータが入り、またAQには、AAにコードがあれば、必ず数字で100以上がはいります。
そういう条件で引っ張ってこれないものでしようか？
すいません。よろしくお願いいたします。
（Ｙuriko.m） 2017/12/13(水) 15:27
なるほどです。 ようやく分かりました。
乾き物(2) のデータは100行よりずーっと下の方に書き出されてしまった、と云う状況です。
・・すると、各シートにつき、10行目から最終合計行までを対象範囲として考えていいですね？
※どのシートのAI列には、必ず最終有効行に「合計」と入っているものとします。 無い場合は、そのシートは無視します。
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Wsh As Worksheet
Dim Rw As Long
If Target.Address <> "$F$9" Then
Exit Sub
Else
Cancel = True
End If
Range("F10:F10000,M10:AQ10000").ClearContents
Application.ScreenUpdating = False
Rw = 9
For Each Wsh In ThisWorkbook.Sheets
If Wsh.Name Like "*月*日*" Then
If Application.CountIf(Wsh.Range("AI10:AI1000"), "合計") > 0 Then
Rw = Rw + 1
Cells(Rw, "F").Value = Wsh.Name
Call MonthlyCpPs(Wsh)
End If
End If
Next
Range("F:AD").EntireColumn.AutoFit
Range("F9").Select
Application.ScreenUpdating = True
End Sub
Private Sub MonthlyCpPs(ByRef Wsh As Worksheet) '１シートの処理
Dim lastRWsrc As Long
Dim lastRWdst As Long
Dim firstCel As Range
Dim TgtRng As Range
With Wsh
lastRWsrc = Application.Max(10, .Cells(.Rows.Count, "AI").End(xlUp).Row)
lastRWdst = Application.Max(9, Cells(.Rows.Count, "M").End(xlUp).Row)
.Range("Z10:AQ" & lastRWsrc).Copy
End With
Set firstCel = Range("M" & lastRWdst + 1) '貼り付け先の先頭セル
firstCel.PasteSpecial xlPasteValuesAndNumberFormats
On Error Resume Next
Set TgtRng = firstCel.Offset(, 9).Resize(lastRWsrc, 1).SpecialCells(xlCellTypeConstants, 23)
On Error GoTo 0
If Not TgtRng Is Nothing Then
Intersect(TgtRng.EntireRow, Columns("M:AD")).Delete Shift:=xlUp
End If
End Sub
（半平太） 2017/12/13(水) 16:13
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.