-2

私はExcelとVBAの初心者です。次のようなシートがあります。

A        B        C         D
someinfo someinfo someinfo OK
someinfo someinfo someinfo OK
someinfo someinfo someinfo ERROR
someinfo someinfo someinfo ERROR
someinfo someinfo someinfo OK
someinfo someinfo someinfo OK
someinfo someinfo someinfo ERROR
someinfo someinfo someinfo ERROR

「OK」の行を新しいシートにコピーし、「ERROR」の行を別のシートにコピーしたいと思います。

どうやってやるの？

4

2 に答える 2

4

以前のコメントで述べたように、これは Filter~>Copy~>Paste の方法です

Sub FilterAndCopy()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


Dim lngLastRow As Long
Dim OKSheet As Worksheet, ErrorSheet As Worksheet

Set OKSheet = Sheets("Sheet2") ' Set This to the Sheet name you want all Ok's going to
Set ErrorSheet = Sheets("Sheet3") ' Set this to the Sheet name you want all Error's going to

lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row


With Range("A1", "D" & lngLastRow)
    .AutoFilter
    .AutoFilter Field:=4, Criteria1:="OK"
    .Copy OKSheet.Range("A1")
    .AutoFilter Field:=4, Criteria1:="ERROR"
    .Copy ErrorSheet.Range("A1")
    .AutoFilter
End With


Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub
于 2013-06-12T17:44:00.090 に答える
2

このようなものを試してみてください...

Set sh = ThisWorkbook.Sheets("Sheet1")
Set sh2 = ThisWorkbook.Sheets("Sheet2")
Set sh3 = ThisWorkbook.Sheets("Sheet3")
lastrow = sh.Cells(Rows.Count, "A").End(xlUp).row
R = 2 
Do While R <= lastrow
     If sh.Range("D" & R) = "OK" Then
         sh.Range("A" & R & ":D" & R).Copy _
         Destination:=sh2.Range("A" & R)
     Else
         sh.Range("A" & R & ":D" & R).Copy _
         Destination:=sh3.Range("A" & R)
     End IF
Loop

ニーズに合わせてデータの取得元の行/列を変更する必要がありますが、私はあなたの例に基づいてこれを書きました.

編集：考え直し て、フィルターについていくつか読んだので、ここに他の人が投稿したものを使用します。

于 2013-06-12T17:35:55.800 に答える