[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『データベースの加工方法』（信州）
単位で下記の2つのデータベースを取込み、手作業で加工していますが、VBAで出来ないか試行錯誤中です。
DB-1のA1～F3865の範囲があるsheetを丸ごとDB-加工.xlsにコピーし、115行～終端行を削除する
②DB-加工.xlsのA列とＢ列の間に1列挿入する
③DB-2のD列の1行からxx行（B列の"04-1298"の次のNoの行）までの範囲をコピーしてDB-加工.xlsの挿入した列に貼り付ける
の作業をVBAで作成しているのですが、①,②がうまくいったのみで③がうまくいきません。
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
'Ａ列とＢ列の間に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
'Ａ列とＢ列の間に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）
それと、質問ですが、
①Set xx =Nothinbgの意味は何でしょうか？
②オープンした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 済
隋時のアップデート時に受付日欄が空になっている行が何行か先端にきている為、その空行のみを削除し、日付のある最新日(現在の日付）が 常に先端行に行くようにしたいのですが。 上記の例では２，３行がＡ列の受付日が空になっており、4行目が8月22日になっていて2～３行を削除し、現在の日付がある行が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の更新の都度、ＤＢ-加工.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）
今度は別の壁にぶつかり、試行錯誤中です。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 名古屋 ＰＣ
8 2005/9/30 05-0502 大阪 ＰＣ
9 2005/9/30 05-0501 東京 ＰＣ
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 東京 ＰＣ
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 長野 ＰＣ
9月度の行（7行～100行）を残して、10月度と8月度の行を自動削除したいのですが、 ①10月始めは2005/10/3が4行あり、10/3で注文書Noの若い方(05-0504)を自動選択する ②8月末は2005/8/31が4行あり、8/31で注文書Noの大きい方(05-0409)を自動選択する ③05-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]]「該当行の抽出方法」で行き詰まってしまいました。
恥を忍んで下記の質問をさせて頂きます。
１： With.offset(,255)の定義は何ででしょうか？EXCEL VBA辞典で調べても、定義がよくわかりません。
2:.Formula = "=IF(MONTH(A2)<>9,1,"""")" 中の１は何を意味しているのでしょうか？
業務DBで行き詰まり、真っ青の信州です・・・・
>１： With.offset(,255)の定義は何ででしょうか？
これはその前の
>With .Range("A2", .Range("A65536").End(xlUp))
から右に255列シフトするという意味です。
A列から右に255列シフトするとIV列になります。
IV列を作業列にしているのです。
>2:.Formula = "=IF(MONTH(A2)<>9,1,"""")" 中の１は何を意味しているのでしょうか？
この「1」は
>編集→ジャンプ→セル選択→数式→数値だけにチェックを入れて→右クリック→削除→行全体→OK
として数値だけを選択したいので「1」としているのです。
F8で一つ一つステップ実行しながらIV列を見ればわかると思います。
>恥を忍んで下記の質問をさせて頂きます。
全然、気にすることはありませんよ。
ただ私はもう以前の様に頻繁にはみていませんので 見逃し等がありましたらごめんなさいです。
ではでは、頑張ってくださいね。
（SoulMan）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.