こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel VBAについて教えて下さい。

00というブックとテストというブックがあります。
00のデータを並び替え、一部変更し、テストのシート3へ貼付けを行いたいのですが、
うまく作動してくれません。以下に現在のコードを記載しましたので、ご指摘いただければと思います。
やりたいことは
1.ブック”00”のシート00にて条件がF列が0、E列がHでソートをかけます。
2.E列のHをすべて数字の1に変更します。
3.今度は別の条件、F列が1、E列がH、D列が1でソートをかけます。
4.E列のHをすべて消去します。
5.すべて表示させA列からE列までのデータを、テストのシート3へ貼付けをします。

コピー&ペーストは上手くいくのですが、肝心のソート+文字の変更+消去が出来ていません。
ネットを見ながら書いたコードで、VBAを勉強中です。
よろしくお願いします。

あと、この作業の前にブック00のB列にて昇順のソートをかけるというコードを追加したいのですが、
それについても教えていただけるとうれしいです。
よろしくお願い致します。


Private Sub Worksheet_Activate()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim i As Long

Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open("C:\Documents and Settings\デスクトップ\メモ\00.xls", ReadOnly:=True)

With wb2.Worksheets("00").Range("A1").CurrentRegion
.AutoFilter
.AutoFilter Field:=6, Criteria1:="=" & "0", Operator:=xlAnd
.AutoFilter Field:=5, Criteria1:="=" & "H", Operator:=xlAnd
.AutoFilter
x = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To x
If Cells(i, 5) = "H" Then
Cells(i, 5) = Replace(Cells(i, 5), "H", "1")
End If
Next i

With wb2.Worksheets("00").Range("A1").CurrentRegion
.AutoFilter
.AutoFilter Field:=6, Criteria1:="=" & "0", Operator:=xlAnd
.AutoFilter Field:=5, Criteria1:="=" & "H", Operator:=xlAnd
.AutoFilter Field:=4, Criteria1:="=" & "1", Operator:=xlAnd
.AutoFilter
x = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To x
If Cells(i, 5) = "H" Then
Cells(i, 5) = Replace(Cells(i, 5), "H", " ")
End If
Next i
wb2.Sheets("00").Range("B1", .Cells(Rows.Count, 5).End(xlUp)).Copy
wb1.Sheets("Sheet3").Range("K3").PasteSpecial

wb2.Close False
Range("A1").Select
Application.ScreenUpdating = True
End With
End With
End Sub

投稿日時 - 2012-02-18 17:41:27

QNo.7312893

すぐに回答ほしいです

質問者が選んだベストアンサー

まずは何が起きてるか調べる、

Dim wb1 As Workbook
から最後の
End With
までを標準モジュールにTEST()でも作って移動。
Worksheet_Activate イベントは以下で十分。

Private Sub Worksheet_Activate()

 Application.ScreenUpdating = False
 Call TEST()
 Application.ScreenUpdating = True

End Sub

で、TEST()をVBEでテストする。Alt+F11で起動できます。

何が起こってるか見えないのでTest()内は
Application.ScreenUpdating = False
をコメントアウトしてください。

TEST()内にカーソルを置いてF8キー押下でステップ実行させると、
一行ごとに実行するので、何が起きてるか、確認できます。
ただし、
ActiveWorkbook
を使用しているので、ブック切り替えを間違えないこと。

余談ですが、Setを使用したのであれば、オブジェクトをNothingにしておくこと。
Text()の最後に以下2行を追加のこと。
Set wb1 = Nothing
Set wb2 = Nothing

投稿日時 - 2012-02-18 20:52:54

お礼

お返事が大変遅くなりまして申し訳ございません。
今後、VBAを作成していく中で大変参考になる回答を頂きありがとうございます。
このようにチェックしていくといいのですね。

投稿日時 - 2012-03-04 09:58:41

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

まず、
>条件がF列が0、E列がHでソートをかけます。
ここでソートという用語は誤用で、フィルタが正しいでしょう。
ご提示のコードでは、オートフィルタをかけたのが生きていません。
オートフィルタの結果を生かすなら、
SpecialCells(xlCellTypeVisible)だけを対象にするか、
EntireRow.Hidden = Falseの行を対象にする必要があります。
前者の方が素直ですが、該当する行が無いときのエラー処理が面倒です。

下記は、シート名等適当にいじって試験したコードです。ご参考まで。
Sub test()
Dim wb1 As Workbook
Dim wb2 As Workbook
'Object変数に入れた方がインテリセンスが効いて便利です
Dim srcRange As Range
Dim myRow As Range

Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open(getDesktopPath & "\" & "test.xls", ReadOnly:=True)
Set srcRange = wb2.Worksheets("Sheet1").Range("A1").CurrentRegion

With srcRange
.AutoFilter
.AutoFilter Field:=6, Criteria1:="=" & "0", Operator:=xlAnd
.AutoFilter Field:=5, Criteria1:="=" & "H", Operator:=xlAnd
'SpecialCellsを用いると、一個もヒットしなかったときのエラー処理が面倒
For Each myRow In .SpecialCells(xlCellTypeVisible).Rows
If myRow.Row <> 1 Then myRow.Columns(5).Value = 1
Next myRow
End With
'または
'For Each myRow In srcRange.Rows
' If myRow.Row <> 1 And myRow.EntireRow.Hidden = False Then myRow.Columns(5).Value = 1
'Next myRow

With srcRange
.AutoFilter
.AutoFilter Field:=6, Criteria1:="=" & "1", Operator:=xlAnd
.AutoFilter Field:=5, Criteria1:="=" & "H", Operator:=xlAnd
.AutoFilter Field:=4, Criteria1:="=" & "1", Operator:=xlAnd
For Each myRow In .SpecialCells(xlCellTypeVisible).Rows
If myRow.Row <> 1 Then myRow.Columns(5).Value = ""
Next myRow
.AutoFilter
End With
'まるごとコピーなら下記でOK
'srcRange.Copy wb1.Sheets("Sheet1").Range("K3")
srcRange.Copy
wb1.Sheets("Sheet1").Range("K3").PasteSpecial (xlPasteValues)
wb2.Close False
Range("A1").Select
Application.ScreenUpdating = True
End Sub

'おまけ
Private Function getDesktopPath() As String
Dim Path As String, WSH As Variant
Set WSH = CreateObject("Wscript.Shell")
getDesktopPath = WSH.SpecialFolders("Desktop")
Set WSH = Nothing
End Function


なお、B列でのソートについては、当方慣れないxl2010でやっていますが、自動記録してみると見知らぬ(2007以降できた様ですが)SortFieldsなんてものが出てきて混乱しておりますので、ご自分でお願いします。

投稿日時 - 2012-02-18 21:23:29

お礼

お返事が大変遅くなりまして申し訳ございません。
頂いた回答を元に修正したところ、思ったとおりの結果を得ることが出来ました。
ありがとうございました。

投稿日時 - 2012-03-04 09:56:41

あなたにオススメの質問