[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『日付データをもとにマクロで列削除を行いたい』(nob)
下記のイメージのShift_ALLシートをもとに、別シートで指定した期間以外の日付列のみ(D列以降)を全てマクロで削除したいと考えています。
目的は1年分の日付が含まれているデータを常に直近2か月分に縮めた上でACCESSへインポートさせたいと考えています。ファイルをVBで複製した後に処理を行う想定です。
[A] [B] [C] [D] [E] [F]
[4] 所属 氏名 社員NO 1/1 1/2 1/3
[5] ABC 佐藤 12345
[6] EFG 田中 67890
例えば月指定シートのA1セルに2015/10/1、A2セルに2015/11/30と入った場合、D列の2015/1/1から、JO列の2015/9/30までの列全体を削除させたいのです。
年初から2月までの間は処理不要です。なおShift_ALLシート4行目のD列以降はすべて日付型です。
そこで過去に弥太郎さんが他の方に対して教示された下記の例を元に試行錯誤したのですが、、
https://www.excel.studio-kazu.jp/kw/20040630135139.html
Sub test() Dim i As Integer Dim data As String Dim maxrow As Long Dim keep_data
If ActiveSheet.Name = "sheet25" Then data = StrConv(Range("a1"), vbNarrow) If data Like "*[!0-9]*" And data Like "*月*" Then For i = 1 To 24 With Worksheets("sheet" & i) 'シート名が変更されとる 'ばやいは with sheets(i)で maxrow = .UsedRange.Rows.Count keep_data = .Cells(2, Val(data)).Resize(maxrow) .Range("a2:l" & maxrow).Clear .Cells(2, Val(data)).Resize(maxrow) = keep_data End With Next i End If End If End sub
恥を承知で示させて頂きます。下記の⇒マーク以降の適切な記述方法が分からず、増してこの状態では所属、氏名、社員NO列も同時に失れてしまうことは理解しているのですが。。
お分かりになる方、ご教示頂けましたら幸いです。
どうか宜しくお願い致します。
Sub test() Dim i As Integer Dim data As String Dim maxrow As Long Dim keep_data
If ActiveSheet.Name = "月指定" Then data = Range("a1,a2").Select With Worksheets("Shift_all")
⇒ maxrow = .UsedRange.Rows.Count keep_data = Range("a1,a2") .Range("a2:l" & maxrow).Clear .Cells(2, Val(data)) = keep_data
End With End If End Sub
< 使用 Excel:Excel2013、使用 OS:Windows7 >
列削除ですから、データ最終行番号を求めるプロセスは 必要ないのと違いますか?
日付データは昇順に入っているのでしょうから、 以下の範囲で削除すればいいんじゃないですか? (1) D列 〜 スタート日付の直前列 (2) エンド日付の次列 〜 最終列
具体的な列番は、Match関数とEndプロパティを使って割り出せませんか?
この説明は矛盾していないですか? (2015/1/1から削除するなら、年初から2月も処理対象ですけど) ↓ > D列の2015/1/1から、JO列の2015/9/30までの列全体を削除させたいのです。 > 年初から2月までの間は処理不要です。
(半平太) 2015/10/19(月) 20:37
半平太さんとかなりダブっていますがメモしましたので。
よくわからないところがあります。
A1に残すFrom、A2 に残すTo を入れるとすれば、From までの列も不要ですし、To の翌日からの列も不要ですよねぇ?
>>年初から2月までの間は処理不要です
この意味もよくわかりません。
4行目の日付が、昇順で、かつ、A1,A2 にいれる日付が必ず、4行目にあるとすれば、それぞれを MatchなりFindなりで検索して そこまでの列、それからあとの列を削除。
こんな処理もできると思いますが、いずれにしても、仕様と要件をもう少し明確にされたらよろしいかと。
(β) 2015/10/19(月) 20:46
= match(月指定!A1,D4:IV4,0)
= Range("d4").End(xlToRight).Column
「年初から2月までの間は処理不要です。」の意味は、2016年1月から2月までの間は2016年データとして2か月分に満たないという理由で3月に達するまでは処理が不要と考えて追記したのですが、混乱を招いてしまい申し訳ありませんでした。
すなわち、下記の要領で列の削除を行いたいと考えています。しかし時には条件変更も必要になりそうなので、別シートで条件を指定できれば理想的と考えました。
2016年3月の場合 ⇒1〜2月分の列を削除
2016年4月の場合 ⇒1〜3月分の列を削除
2016年5月の場合 ⇒1〜4月分の列を削除
βさん
度々のご厚意に感謝いたします。的確にお伝え出来ず混乱を招いてしまい申し訳ありませんでした。
詳細は半平太さん宛に書かせて頂いたとおりなのですが、match関数、endプロパティについて調べてみて納得しつつも応用が利かず困惑しています。
改めてご指導頂ければ幸いです。。
(nob) 2015/10/19(月) 23:10
別シートに指定日付条件をセットするということには異論は全くないのですが、 本件の処理そのものに、【年初から2月までの間は処理不要です】は、全く必要のないコメントだったので 戸惑いました。
私が質問した、
・開始指定、終了指定 の日付は4行目に存在するのか、ない場合もありえるのか。 ・終了指定日によっては、後ろのほうの列も削除対象になりうるのではないか。
これについて回答をいただけていないのですが、シート上の一番左の列の日付を、終了日として指定するから、 そんな心配は不要?
であれば、残す日付の内、終了日付はいらないのでは?
指定日付が4行目にない場合もありうるなら、照合型 1 のMATCHを使うところですが、必ずあるとして。
以下ではいかがですか?
Sub Test() Dim fR As Range Dim tR As Range Dim zR As Range
With Sheets("Shift_ALL")
Set fR = .Rows(4).Find(what:=Sheets("月指定").Range("A1").Value, LookAt:=xlWhole, LookIn:=xlFormulas) Set tR = .Rows(4).Find(what:=Sheets("月指定").Range("A2").Value, LookAt:=xlWhole, LookIn:=xlFormulas)
If fR Is Nothing Or tR Is Nothing Then MsgBox "指定の日付がありません" Exit Sub End If
Set zR = .Cells(4, Columns.Count).End(xlToLeft) If tR.Column < zR.Column Then .Range(tR.Offset(, 1), zR).EntireColumn.Delete
If fR.Column > 4 Then .Columns("D").Resize(, fR.Column - 4).Delete
End With
End Sub
(β) 2015/10/20(火) 02:12
早速のご指導に心から感謝いたします。
素晴らしいです。。。もう少し簡素に済むかと想像していたのですが甘かったです。拝見した瞬間、目が点になりました。
日付行がずれた場合にもメッセージが表示されましたので本当にありがたいです。
月指定シートのA1セルには、=DATE(YEAR(TODAY()),MONTH(TODAY()),1) の式を入れて使用させて頂きます。
月指定シートのA2セルの活用もご配慮頂きありがとうございます。
試しに12/31までの列を追加した上でA2セルに11/30の日付を入れてみましたが未来分の列の変化は起きませんでした。解釈を誤っていた場合は申し訳ありません。
下記の記述がA2セルの条件に関わっていると思いましたが、単語個別では調べた上で何となく理解できても連なると自分には高度すぎてお手上げです。
もし宜しければ下記2行のみでも簡単に解説頂ければ大変ありがたいです。
Set zR = .Cells(4, Columns.Count).End(xlToLeft)
上記はD列を起点に列数のカウントを行っているのかと想像しますが、Endの意味は日付が入力された最終列を探しているのでしょうか。
D列を起点にした場合、未来の日付は右方向になりますが、xlToLeftと記述されている訳は何故でしょうか。
If tR.Column < zR.Column Then .Range(tR.Offset(, 1), zR).EntireColumn.Delete
A2セル値 < 列数カウント?? 特にこの削除条件の記述について簡単にご教示頂けませんでしょうか。
まだ自分には程遠いレベルではありますが、厚かましいながらも少しでも学習させて頂きたい思いです。
決して急いではおりませんので、お手すきの際にどうかよろしくお願い致します。
(nob) 2015/10/20(火) 12:10
>>試しに12/31までの列を追加した上でA2セルに11/30の日付を入れてみましたが未来分の列の変化は起きませんでした
不思議ですねぇ。 こちらで Shift_ALLシートのD4が 1/1 、ずっと連続してND4が12/31 この状態で、文書シートのA1 には、そちらの式。(結果、日付は 2015/10/1) A2 に 手入力で 2015/11/30 。 実行結果は,D4が 10/1、BL4 が 11/30 で、BM4から右が何もなしという状態ですが?
それはさておき、質問の件。
Set zR = .Cells(4, Columns.Count).End(xlToLeft)
Cells は Cells(行番号,列番号) です。ですから、この4 は 4列目(D列)ではなく、4行目という意味です。 で、列番号が Collumns.Count。これはエクセルの物理的な最大列数。xl2003までは 256、xl2007以降は16384。 なので、.Cells(4, Columns.Count) は xl2007以降なら 4行目の16394列目。つまり、XFD4 です。 で、このセルを起点に 左方向に眺めて最初に値がある列。これが、その行のデータ最終列ということになります。 今回の仕様は、日付がD1から始まり、抜けなく(空白セルなく)連続していますから、 .Range("C1").End(xlToRIght) でもいいのですが。
If tR.Column < zR.Column Then .Range(tR.Offset(, 1), zR).EntireColumn.Delete
tR は、終了日付セル。tR.Column は、その列番号。 zR は、データ最終セル。
基本的には、tRの次の列からデータ最終列までを削除すればいいのですが、もし、tRがデータ最終セルなら 削除の必要はないわけですので、条件を判定しています。 で、条件OKなら、.Range(tR.Offset(, 1), zR) が、tRの1つ右のセルからzRまでの領域ということで、 .Range(tR.Offset(, 1), zR).EntireColumn は、その領域の列全体という意味になります。
(β) 2015/10/20(火) 19:03
未来日付列の削除が機能しない件、ファイルの再作成、各セル書式の変更など色々と試してみたのですが変化がありませんでした。
とりあえず支障は無いのですが、悔しいので引き続き探ってみます。判明した際はその旨追記させて頂きます。
詳細な解説を頂きありがとうございます。噛み砕くのに時間が掛りました。なるほど。。。
経験を重ねることも重要だと改めて感じました。
しかし天才の域ですね。
本当にありがとうございました。
(nob) 2015/10/21(水) 10:54
天才とは?
https://ja.wikipedia.org/wiki/%E5%A4%A9%E6%89%8D
ここの回答者にはほとんど天才はいないと思う。 努力の賜物だと思う。 (カエムワセト) 2015/10/21(水) 11:12
カエムワセトさんコメントの通り、どれだけ多くの失敗と苦しみを味わって、どれだけ汗をかいたか、 その積み重ねでしょうねぇ。私なんぞは、まだまだ汗が足りないのですが。 (はるか昔に還暦を過ぎたので、もう、ひからびて、汗そのものも出てこない?)
(β) 2015/10/21(水) 20:46
βさん
そうだったんですね。尊敬します。βさんの生き方。
改めて勉強になったと同時に刺激になりました。
ありがとうございます。
未来列削除の件、また幾つか試してみたのですがまだ解決出来ず悔しいです。
申し訳ありません。
(nob) 2015/10/22(木) 11:12
>>未来列削除の件、また幾つか試してみたのですがまだ解決出来ず悔しいです。
だめもとで、
Set zR = .Cells(4, Columns.Count).End(xlToLeft)
を
Set zR = .Range("C1").End(xlToRight)
にしたらどうなるでしょうか?
(β) 2015/10/22(木) 12:42
(nob) 2015/10/22(木) 19:02
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.