[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『エラー処理の仕方』（ブルークロス）
よろしくお願いします。
売上と言うフォルダに1月.xlsx～12月.xlsxがあります。
データはどれも同じような体裁で、Sheet1に下記のようなデータが入っています。
月ごとに内容や行数は変わりますが、列数は増えません。
A B C
1 送付先 品名 金額
2 山梨県 りんご 30,000
3 山梨県 いちご 250,000
4 長野県 バナナ 7,500
5 新潟県 りんご 45,000
6 栃木県 バナナ 15,110
7 千葉県 りんご 28,003
8 千葉県 いちご 314,919
9 千葉県 なし -14,194
10 埼玉県 りんご 138,830
11 埼玉県 いちご 109,468
12 神奈川県 なし 6,052,267
13 神奈川県 りんご -256,597
14 東京都 なし 230,040
15 東京都 りんご 23,667
16 東京都 バナナ 4,839
17 東京都 りんご 286,840
18 東京都 いちご 3,594
同じフォルダ内の、まとめ.xlsmにはマクロの記録から、ネットで検索して継ぎ接ぎのように足したコードがあります。
任意のファイルから送付先か品名を抽出させて、最終行の下に貼り付けるものです。
Sub 月ごとの抽出()
Dim OpenFileName As String
Dim sai As Integer
Dim lio As String
Dim n As String
OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls*")
If OpenFileName <> "False" Then
Workbooks.Open OpenFileName
End If
sai = InputBox("何行目を抽出しますか")
lio = InputBox("抽出したい現場名か支払先")
Application.ScreenUpdating = False
Selection.AutoFilter
ActiveSheet.Range("A1:E200").AutoFilter Field:=sai, Criteria1:=lio
Range("A2:E200").Select
Selection.Copy
ThisWorkbook.Activate
ActiveSheet.Paste
n = Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & n).Select
ActiveWindow.ActivateNext
Application.CutCopyMode = False
Selection.AutoFilter
Range("A1").Select
ActiveWorkbook.Save
ActiveWindow.Close
Application.ScreenUpdating = True
End Sub
これで何とか動いていますが、インプットボックスに何も入れないとエラーが出ます。
何も入れない場合やキャンセルを押した時に、開いたファイルをそのまま閉じて終了する方法があるか教えていただけませんでしょうか。
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
Sub test()
Dim wb As Workbook
Dim sai As Variant
OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls*")
If OpenFileName <> "False" Then
Set wb = Workbooks.Open(OpenFileName)
End If
sai = InputBox("何行目を抽出しますか")
If sai = "" Then
wb.Close False
Exit Sub
Else
sai = Val(sai)
End If
'---ここはブックを開いた後の処理等
wb.Close False
End Sub
または、ブックを開くより前に、行やその他の入力をさせてしまえば、中断用closeが不要になりますよ。
（???） 2018/10/12(金) 15:44
（ブルークロス） 2018/10/12(金) 16:20
また、
Selection.AutoFilter
ActiveSheet.Range("A1:E200").AutoFilter Field:=sai, Criteria1:=lio
ここって想定通りうごいてるのかちょっと心配です。
たぶん、上の行で「アクティブシート」のオートフィルタを”解除”して
下の行で「アクティブシート」の"A1:E200"セルにオートフィルタを設定してるんですよね？
（もこな２） 2018/10/12(金) 16:35
ActiveSheet.Range("A1:E200").AutoFilter Field:=sai, Criteria1:=lio
ここの部分に関しては、マクロの記録にネットで調べたものを書き換えています。
それでなんとか動いてる状況です。
あまり上手くない動きなのかも知れません。
（ブルークロス） 2018/10/12(金) 17:04
Selection.AutoFilter
ctiveSheet.Range("A1:E200").AutoFilter
1行目の記述ですと、
（開いたブック）の（アクティブシート）の「選択されているセル」に「オートフィルタ」を設定/解除になります。
※「選択されているセル」が単一セルだったときは、当該を含む表範囲と解釈される。
ですので、目的のブックを開いた時に
対象となるシートがアクティブだった場合
オートフィルタが設定されている場合
オートフィルタを解除して、「A1:E200」にオートフィルタを設定 → 成功
オートフィルタが設定されておらず、「A1:E200」のいずれかの単一セルが選択されている場合
A1:E200にオートフィルタを設定 → 成功
オートフィルタが設定されておらず、「A1:E200」の一部のみが選択されている場合
選択されている範囲のみにオートフィルタを設定 → 失敗
オートフィルタが設定されておらず、「A1:E200」以外の単一セルあるいはセル範囲が選択されている場合
エラーになるか目的じゃない場所にオートフィルタが設定される → 失敗
対象となるシート以外がアクティブだった場合
目的シート以外でオートフィルタの操作をすることになる → 失敗
という点が心配です。
（もこな２） 2018/10/13(土) 15:24
気になる点としては上記の通りですが、
そもそも論として
＞売上と言うフォルダに1月.xlsx～12月.xlsxがあります。 なので、ブックごとにオートフィルタ＆コピーをするのではなく、一度集約用のシートに全データをコピーしてきて、そこから抽出するようにしてみてはどうでしょうか。
オートフィルタの部分はさておき、同じフォルダに「1月.xlsx～12月.xlsx」が保存されていて、かつの対象となるシートが1番目のシートで固定されているなどであれば、集約ブックに集めるのはそう難しい話でもないと思います。
適当に組んでテストしてないですけど、↓みたいに項目行を含めないで集約用のシートに累積されるようコピーしていけばいいですよね。
Sub サンプル()
Dim i As Long, ふらぐ As Long
Dim dstSH As Worksheet: Set dstSH = ThisWorkbook.Worksheets("集約用")
Dim srcRNG As Range, dstRNG As Range
dstSH.Cells.Delete
dstSH.Range("A1").Value = "由来ブック名"
Set dstRNG = dstSH.Range("B1")
For i = 1 To 12 Step 1
With Workbooks.Open("D:\WORK\売上\" & i & "月.xlsx").Worksheets(1)
Set srcRNG = Intersect(.UsedRange, .UsedRange.Offset(ふらぐ))
If Not srcRNG Is Nothing Then
srcRNG.Copy dstRNG
dstRNG.Offset(, -1).Resize(srcRNG.Rows.Count).Value = .Parent.Name
Intersect(.UsedRange, .UsedRange.Offset(ふらぐ)).Copy _
dstSH.Cells(dstSH.Rows.Count, "A").End(xlUp).Offset(1)
ふらぐ = 1
Set dstRNG = dstSH.Cells(dstSH.Rows.Count, "B").End(xlUp)
.Parent.Close
End If
End With
Next i
End Sub
（もこな２） 2018/10/13(土) 18:41
ファイルを家のPCでやってみたところ、1月.xlsxは52行ほどしか無いにも関わらず、
A列に1月.xlsxと言うファイル名がそのままズラッと2031行まで書かれており、2032行目に同じ1月のデータが貼られてしまいました。
12月ファイルまでその繰り返しになってしまいました・・・。
やり方が悪かったのかも知れません。
しかしながら、他にも方法があると教えて頂きありがとうございました。
（ブルークロス） 2018/10/14(日) 23:15
Sub サンプル弐()
Dim i As Long, ふらぐ As Boolean
Dim dstSH As Worksheet: Set dstSH = ThisWorkbook.Worksheets("集約用")
Dim srcRNG As Range, dstRNG As Range
Dim sai As Integer, lio As String
Stop
'集約シートのクリア等
dstSH.Cells.Delete
dstSH.Range("A1").Value = "由来ブック名"
'集約用のシートにデータを集める処理
For i = 1 To 12 Step 1
With Workbooks.Open("D:\WORK\売上\" & i & "月.xlsx").Worksheets(1)
'1回目の時だけ項目行をコピー
If Not ふらぐ Then
.UsedRange.Rows(1).Copy dstSH.Range("B1")
ふらぐ = True
End If
'項目行以外を「srcRNG」に格納
Set srcRNG = Intersect(.UsedRange, .UsedRange.Offset(1))
'「srcRNG」に格納されたものがあれば(Nothing以外が格納されていれば)コピペ等を実行
If Not srcRNG Is Nothing Then
Set dstRNG = dstSH.Cells(dstSH.Rows.Count, "B").End(xlUp).Offset(1)
srcRNG.Copy dstRNG
dstRNG.Offset(, -1).Resize(srcRNG.Rows.Count).Value = .Parent.Name
End If
.Parent.Close
End With
Next i
'
'
'集約用のシートにオートフィルタをかける処理
sai = InputBox("左から何【列】目を抽出しますか")
lio = InputBox("抽出したい現場名か支払先")
With ThisWorkbook.Worksheets("出力用") '←抽出結果を貼付けたいシートに適宜変更
'↓このようにすれば、オートフィルタの状態にかかわらず必ず解除される
dstSH.AutoFilterMode = False
'↓こうすればExcel君の方で「そのセルが含まれる表範囲」と解釈してオートフィルタフィルタを設定してくれる
dstSH.Range("A1").AutoFilter Field:=sai, Criteria1:=lio
dstSH.Range("A1").CurrentRegion.Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
End With
End Sub
（もこな２） 2018/10/15(月) 01:07
深夜に申し訳ありません。
実はあの切り貼りマクロでデータを抽出し、何とか動いて良かった良かった…と思っていたのですが…。
何月のファイルか分からないな…とも思っていました。
これなら、ファイル名も入るので一目瞭然で感動いたしました。
細かにコメントも付けていただき、勉強になります。
午前中バタバタして、お礼が遅れて申し訳ありません。
今回は本当にありがとうございました。
（ブルークロス） 2018/10/15(月) 16:20
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.