[[20050810143236]] 『データベースの加工方法』(信州) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『データベースの加工方法』(信州)

 単位で下記の2つのデータベースを取込み、手作業で加工していますが、VBAで出来ないか試行錯誤中です。

 DB-1のA1〜F3865の範囲があるsheetを丸ごとDB-加工.xlsにコピーし、115行〜終端行を削除する

ADB-加工.xlsのA列とB列の間に1列挿入する

BDB-2のD列の1行からxx行(B列の"04-1298"の次のNoの行)までの範囲をコピーしてDB-加工.xlsの挿入した列に貼り付ける

の作業をVBAで作成しているのですが、@,AがうまくいったのみでBがうまくいきません。

DB-1.xls

	  A	  B	  C	  D	  E	F	
1	受付日	注文書No	顧客県	品物	配送日	決済	
2	8/10/05	05-0114	東京	お菓子		未  最新行
3	8/5/05	05-0113	大阪	お米	8/10/05	未	
4	8/3/05	05-0112	埼玉	お酒	8/7/05	未	
5	8/1/05	05-0111	広島	玩具	8/6/05	済	
6	7/31/05	05-0110	東京	衣類	8/5/05	済	
xx	 *	05-xxxx	 *	 *	 *	*	
115	3/31/05	04-1298	新潟	お米	4/10/05	済  データ取込時の行
116	3/31/05	04-1297	東京	お酒	4/10/05	済	
xxx	 *	 *	 *	 *	 *	*	
3865	12/8/00	00-2052	山形	お酒	1/15/01	済  終端行

DB-2.xls

	  A	  B	 C	  D	  E
1	受付日	注文書No	顧客県	連絡日	配送日
2	8/10/05	05-0114	東京		
3	8/5/05	05-0113	大阪	8/8/05	8/10/05
4	8/3/05	05-0112	埼玉	8/1/05	8/7/05
5	8/1/05	05-0111	広島		8/6/05
6	7/31/05	05-0110	東京	8/2/05	8/5/05
xx	*	05-xxxx	 *	 *	 *
115	3/31/05	04-1298	新潟	4/6/05	4/10/05
116	3/31/05	04-1297	東京	4/6/05	4/10/05
xxx	 *	 *	 *	 *	 *
3865     12/8/00	00-2052	山形	12/24/00	1/15/01

DB-加工.xls

	  A	  B	  C	  D	  E	  F	G
1	受付日	連絡日	注文書No	顧客県	品物	配送日	決済
2	8/10/05		05-0114	東京	お菓子		未
3	8/5/05	8/8/05	05-0113	大阪	お米	8/10/05	未
4	8/3/05	8/1/05	05-0112	埼玉	お酒	8/7/05	未
5	8/1/05		05-0111	広島	玩具	8/6/05	済
6	7/31/05	8/2/05	05-0110	東京	衣類	8/5/05	済
xx	  *	  *	05-xxxx	 *	 *	 *	*

こちらで作成したVBAは下記の通り

Sub コピーと加工()

 'DB-1.xlsからのコピー
  Workbooks.Open ("C:\Documents and Settings\My Documents\Excel\DB-1.xls")
  ActiveWorkbook.Worksheets("DB-1").Copy after:=ThisWorkbook.Worksheets(1)
 'コピー先sheet名の変更
  Worksheets("DB-1").Name = "DB-加工"
  Workbooks("DB-1.xls").Activate
  ActiveWindow.Close

  '行削除
     MyInp = "04-1298"
   Set r = ActiveSheet.Range("B2:B65536").Find(MyInp, LookIn:=xlValues, LookAt:=xlWhole)

   LastRow = Range("B65536").End(xlUp).Row

     Range(Cells(r.Row, 1), Cells(LastRow, 50)).Delete Shift:=xlShiftUp
     Range("A20").End(xlDown).Select
   Range("A8").Select
  'A列とB列の間に1列挿入
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Range("B1").Select
  'DB-2.xlsの”連絡日”項のコピー
   Workbooks.Open ("C:\Documents and Settings\My Documents\Excel\DB-2.xls")

   以降の記述がわかりません。どなたかご教示下さい。m(_ _)m m(_ _)m  

End Sub


 多分、こんなことかと思うけど、、どうでしょうか?
パスとかSheet名はそちらにあわせてください。
一応、こちらでテストはしています。
インデックスが有効範囲にありませんとかのエラーはシート名とかBook名がないということですから
よく確認してくださいね。
それから、変数をしっかりと宣言して変数を使うようにするとコーディングが楽になるので参考にしてください。
それからもう一点、
ActiveSheet
などという記述はなるべく避けてしっかりと親のオブジェクトから記述する習慣を付けた方がいいです。
もう一点
Findの引数は省略してはいけません。
どうでしょうか?
Option Explicit
Sub コピーと加工()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim wh As Worksheet
Dim MyInp As String
Dim r As Range
Dim FirstRow As Long
Dim LastRow As Long
Set wb1 = Workbooks.Open("C:\WINDOWS\Profiles\SoulMan\My Documents\DB-1.xls")
Set wb2 = Workbooks.Open("C:\WINDOWS\Profiles\SoulMan\My Documents\DB-2.xls")
Set wh = ThisWorkbook.Worksheets("DB-加工")
'DB-1のA1〜F3865の範囲があるsheetを丸ごとDB-加工.xlsにコピーし、115行〜終端行を削除する
'DB-1.xlsからのコピー
wb1.Worksheets("DB-1").Cells.Copy Destination:=wh.Range("A1")
'行削除
MyInp = "04-1298"
With wh
    Set r = .Columns("B:B").Find(MyInp, , xlValues, xlWhole, xlByRows, xlNext, True)
    FirstRow = r.Row
    LastRow = .Range("B65536").End(xlUp).Row
    .Rows(FirstRow & ":" & LastRow).Delete Shift:=xlUp
    'A列とB列の間に1列挿入
    .Columns("B:B").Insert Shift:=xlToRight
    'DB-2.xlsの”連絡日”項のコピー
    'DB-2のD列の1行からxx行(B列の"04-1298"の次のNoの行)までの範囲をコピーして
    'DB-加工.xlsの挿入した列に貼り付ける
'    'この時DB-2も"04-1298"の位置を検索するのなら
'    '************************
'    Set r = wb2.Worksheets("DB-2").Columns("B:B").Find(MyInp, , xlValues, xlWhole, xlByRows, xlNext, True)
'    wb2.Worksheets("DB-2").Range("D1:D" & r.Row + 1).Copy Destination:=.Range("B1")
'    '**************************
    '検索しないのなら
    wb2.Worksheets("DB-2").Range("D1:D" & FirstRow + 1).Copy Destination:=.Range("B1")
End With
Set r = Nothing
Set wh = Nothing
Set wb2 = Nothing
Set wb1 = Nothing
End Sub
(SoulMan)


soulmanさんへ  
ありがとうございます。
VBAプログラミングの基礎を勉強し直します。

それと、質問ですが、
@Set xx =Nothinbgの意味は何でしょうか?
AオープンしたDB-1.xls,DB-2.xlsを閉じる場合

Set wb1c = Workbooks.Close("C:\WINDOWS\Profiles\SoulMan\My Documents\DB-1.xls")

Set wb2c = Workbooks.Close("C:\WINDOWS\Profiles\SoulMan\My Documents\DB-2.xls")
と記述して、Set r = Nothingの上に入れましたが、コンパイルエラー(引数の数が一致していません。または不正なプロパティを指定しています)が出てしまいました。

記述のどこに問題があるのでしょうか?

by 信州


 あっ、閉じてなかったですね?
閉じるのは、
wb1.Close True
wb2.Close True
を
Set r = Nothing
Set wh = Nothing
Set wb2 = Nothing
Set wb1 = Nothing
の前に記述してください。
それから画面がちらつく様でしたら、
Application.ScreenUpdating = False
をなるべくコードの先頭に記述して
Application.ScreenUpdating = True
をなるべくコードの最後に記述すればいいです。
画面の更新を停止するものです。
 >Set xx =Nothinbgの意味は何でしょうか?
これは、Set ステートメントといって
オブジェクト変数にオブジェクトを代入するのもです(あってるかな??(^^;)
今回の様に三つのBookを扱う時などに
wb1.Worksheets("DB-1").Cells.Copy Destination:=wh.Range("A1")
は
Workbooks("DB-1.xls").Worksheets("DB-1").Cells.Copy Destination:=ThisWorkbook.Worksheets("DB-加工").Range("A1")
と書くことも出来るのですね。
でも単調で可読性が悪いですよね。そんな時にwb1という変数にWorkbooks("DB-1.xls")をセットすることで
wb1はWorkbooks("DB-1.xls")そのものとして扱うことが出来るのです。
でも、普通の変数と違ってオブジェクト変数はなんらかのインスタンスが残るので私は明示的にNothingをセットして
開放しています。コードを書く上での基本だと思っています。
この件については過去に論じられたことがあるので参考にしてください。
[[20041124212113]]『VBA:変数の開放の必要性』(みやほりん) 
どうでしょうか?
それからこれは余談ですが、このボードに書き込む時は文節の先頭に半角のスペースを入れるといいですよ。
←ここです。ここに半角のスペースを入れてください。
編集画面で見比べていただければすぐにわかります。
それからまる文字は機種依存ですのでネットでの使用は控えてくださいね。
(SoulMan)


 Findの引数を省略してはいけない、との指摘ですが、Excel 2000VBA辞典を引くと
object.Find(What,After,LookIn,LookAt,SearchOrder,SearchDirection,MatchCase,MatchByte)の8項があるのですが、
これらを残らず全て記述する必要がある、という事ですか?
又、Find(MyInp, , xlValues, xlWhole, xlByRows, xlNext, True)との対応関係は 
what=MyInp,
After=空白,
LookIn=xlValues,
LookAt=xlWhole,
SearchOrder=xlByRows,
SearchDirection=xlNext,
MatchCase=true,
MatchByte=True?  でしょうか?
 by 信州

 私が引き数を省略してはいけません。といっているのは以下Helpからですが
 >解説
 >引数 LookIn、LookAt、SearchOrder、および MatchByte の設定は、このメソッドが使われるたびに保存されます。
 >次にこのメソッドを使うときに、これらの引数の指定を省略すると、保存された設定が使われます。
 >これらの引数の設定を変更すると、[検索] ダイアログ ボックスに表示される設定が変わります。
 >また、[検索] ダイアログ ボックスで設定を変更すると、保存されている設定が変わります。
 >このような設定の変更によって生じる問題を避けるためには、Find メソッドを使うたびに、これらの引数を明示的に指定します。
 の為です。
 >MatchByte   
 >省略可能です。バリアント型 (Variant) の値を使用します。
 >この引数は、2 バイト (全角) 文字の言語サポートが選択またはインストールされているときだけ使用できます。
 >半角と全角を区別するには、True を指定します。区別しないようにするには、False を指定します。
 とあるので時と場合によっては使用出来ない場合もあるでしょう?
 それよりも、Findを使用する場合は実際に編集→検索を実行して望み通りの結果が得られることを確認してから
 使用するのがいいです。その上で、それを記録してコードに使用すればコード中でも思い通りの結果が得られるでしょう。
 という私の自論かもしれません。必要ないとお考えでしたら私に遠慮なく省略されればいいと思います。
(SoulMan)


 長〜い夏休みが終わり、本日から職場に復帰です。夏休みボケが抜けきらず、ついうとと・・・何ちゃって

 さて、下記のデータについてですが、空行を削除する方法はどの様に記述したらいいかご教示下さい。
       A	  B	  C	  D	  E	  F	G
1	受付日	連絡日	注文書No	顧客県	品物	配送日	決済
2                                    福岡   お酒        未
3                                    栃木   お茶        未
4	8/22/05		05-0114	東京	お菓子		未
5	8/5/05	8/8/05	05-0113	大阪	お米	8/10/05	未
6	8/3/05	8/1/05	05-0112	埼玉	お酒	8/7/05	未
7	8/1/05		05-0111	広島	玩具	8/6/05	済
8	7/31/05	8/2/05	05-0110	東京	衣類	8/5/05	済

 隋時のアップデート時に受付日欄が空になっている行が何行か先端にきている為、その空行のみを削除し、日付のある最新日(現在の日付)が
 常に先端行に行くようにしたいのですが。 
 上記の例では2,3行がA列の受付日が空になっており、4行目が8月22日になっていて2〜3行を削除し、現在の日付がある行が2行に行く
 ような記述をしたいのです。

 ’空行削除
DIM MyInp as Sring
DIM MyToday as DATE
MyInp = ""
MyToday= TODAY()
With wh
    Set r = .Columns("A:A").Find(MyInp, , xlValues, xlWhole, xlByRows, xlNext, True)
    FirstRow = r.Row
    LastRow = .Range("MyToday").End(xlUp).Row
    .Rows(FirstRow & ":" & LastRow).Delete Shift:=xlUp

 と記述したのですが、エラーになってしまいます。(信州)

 A列を選択して
編集→ジャンプ→セル選択→空白セル→右クリック→削除→行全体→OK
でどうでしょうか?
うまくいけば記録されればいいでしょう
(SoulMan)


 SoulMan先生へ
 一発でうまくいきました。有難うございます!マクロ機能でできる部分もあったんですね〜 (信州)

 すみません。
 DB-加工.xlsの更新の都度、DB-加工.xlsのworksheets(”DB-加工”)をクリアしたいのですが、その記述で質問があります。
 マクロでやった  
  Cells.Select
    Selection.Clear
    Range("A1").Select を

   Worksheets("DB-加工").Cells.Select
    Selection.Clear
    Range("A1").Select  にすると、エラーになってしまいます。どこに問題があるかご教示下さい。

 Worksheets("DB-加工").Cells.Clear
で、いいかと思います。
(SoulMan)

久し振りの投稿です。信州は朝、夜は冷え込み、すっかり秋めいて来ましたが小生は半袖で頑張っています。いつまで持つことやら〜

さて、現在日付関数の取り扱いでてんてこ舞い中です。
本日の日付を自動的にsheetの名前に付け加えたいのですが、その設定がうまくいきません。 又、日付関数はそのままではシート名に入れられない(2005/9/29)のと、Excelに”0929”という日付関数がないのでどうしたものか?と悩んでいます。

 sheet1 --> sheet(更新日-0929)に自動変換できないかな?と思案中です。

 InpBox で入力する手もありますが、出来るだけオート化したいです。

Sub 更新()

 Dim d As Date

 d=TODAY()

 sheets(1).name="更新日-”  &  d

 End sub

と試したのですが、コンパイルエラー"Sub又はFunctionが定義されていません"というエラーメッセージが出てしまいます。
どなたかご教示頂ければ有り難く存じます。


 こんばんは!
前後のレスと関係がない?場合は新しくレスをたてられた方がいいですよ(^^;
ところで、とりあえずこんな感じでどうでしょうか?
Option Explicit
Sub 更新()
Sheets(1).Name = Format(Date, "更新日-mmdd")
End Sub
(SoulMan)

soulman先生、有難うございます!

 今度は別の壁にぶつかり、試行錯誤中です。DB-加工.xlsが下記の様になってる場合、
       A	         B	   C	 D
1    受付日      注文書No	 顧客県	品物
2    2005/10/4  05-0508	  東京	お菓子
3    2005/10/3  05-0507	  大阪	お米
4    2005/10/3  05-0506	  埼玉	お酒
5    2005/10/3  05-0505	  広島	玩具
6    2005/10/3  05-0504	  東京	衣類
7    2005/9/30  05-0503	  名古屋	PC
8    2005/9/30  05-0502	  大阪	PC
9    2005/9/30  05-0501      東京	PC
10   2005/9/29  05-0500	  札幌	お酒
11   2005/9/29  05-0499	  東京	お米
12   2005/9/28  05-0498	  博多	お菓子
 *   2005/9/**  05-04**	   *       *
 *   2005/9/**  05-04**	   *	  *
99   2005/9/1   05-0411	  東京	PC
100  2005/9/1   05-0410	  東京	家電
101  2005/8/31  05-0409	  新潟	家電
102  2005/8/31  05-0408	  大阪	お米
103  2005/8/31  05-0407	  東京	衣類
104  2005/8/31  05-0406	  長野	PC

 9月度の行(7行〜100行)を残して、10月度と8月度の行を自動削除したいのですが、
 @10月始めは2005/10/3が4行あり、10/3で注文書Noの若い方(05-0504)を自動選択する
 A8月末は2005/8/31が4行あり、8/31で注文書Noの大きい方(05-0409)を自動選択する
 B05-0503〜05-410の行を残して他の行を削除する 
 の記述方法がよくわかりません。今は手作業で削除しているので、それがしんどいです。
 実際は数百行もある為、探すのが大変です。

 宜しくお願いします。m(_ _)m m(_ _)m

 >9月度の行(7行〜100行)を残して、10月度と8月度の行を自動削除したいのですが、
 ということでしたら、
 >編集→ジャンプ→セル選択→空白セル→右クリック→削除→行全体→OK
 >でどうでしょうか?
 >うまくいけば記録されればいいでしょう
 上の回答の応用で
 =IF(MONTH(A2)<>9,1,"")
 という式を入力して
編集→ジャンプ→セル選択→数式→数値だけにチェックを入れて→右クリック→削除→行全体→OK
とされてはどうでしょうか?
ちなみに記録して加工すると
↓こんな感じになるかと思います。
それから、この様な場合は別にレスを立てられた方がより早くよりいい回答を得られますから
別にレスを立てられた方がいいですよ。
Option Explicit
Sub てすと()
With Sheets("Sheet1")
    With .Range("A2", .Range("A65536").End(xlUp))
        With .Offset(, 255)
            .Formula = "=IF(MONTH(A2)<>9,1,"""")"
            On Error Resume Next
                .SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
            On Error GoTo 0
        End With
    End With
End With
End Sub
(SoulMan)


 SoulMan先生!神頼みの質問です。上記のVBAの内、
       With .Offset(, 255)
            .Formula = "=IF(MONTH(A2)<>9,1,"""")"
 の文法の意味がわからず、別レス 
[[20051018111808]]「該当行の抽出方法」で行き詰まってしまいました。
 恥を忍んで下記の質問をさせて頂きます。
 1: With.offset(,255)の定義は何ででしょうか?EXCEL VBA辞典で調べても、定義がよくわかりません。

 2:.Formula = "=IF(MONTH(A2)<>9,1,"""")" 中の1は何を意味しているのでしょうか?

 業務DBで行き詰まり、真っ青の信州です・・・・


 >1: With.offset(,255)の定義は何ででしょうか?
 これはその前の
 >With .Range("A2", .Range("A65536").End(xlUp))
 から右に255列シフトするという意味です。
 A列から右に255列シフトするとIV列になります。
 IV列を作業列にしているのです。
 >2:.Formula = "=IF(MONTH(A2)<>9,1,"""")" 中の1は何を意味しているのでしょうか?
 この「1」は
 >編集→ジャンプ→セル選択→数式→数値だけにチェックを入れて→右クリック→削除→行全体→OK
 として数値だけを選択したいので「1」としているのです。
 F8で一つ一つステップ実行しながらIV列を見ればわかると思います。
 >恥を忍んで下記の質問をさせて頂きます。 
 全然、気にすることはありませんよ。
 ただ私はもう以前の様に頻繁にはみていませんので 見逃し等がありましたらごめんなさいです。
 ではでは、頑張ってくださいね。
(SoulMan)


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.