1

以下のようにExcelにシートがあります

1   apple   8/1/2013    8/2/2013    99373        11
2   apple   8/13/2013   8/3/2013    2626282    2121
3   berry   8/12/2013   8/4/2013    1289127     123
4   berry   8/15/2013   8/5/2013    12712671   1234
5   cherry  8/19/2013   8/6/2013    127127     3354
    apple   9/1/2013    9/5/2013    123456      200
    apple   9/2/2013    9/6/2013    246810      300
    berry   9/3/2013    9/7/2013    3691215     400
    berry   9/4/2013    9/8/2013    48121620    500
    cherry  9/5/2013    9/9/2013    510152025   600
    cherry  9/6/2013    9/10/2013   612182430   700
    apple   9/7/2013    9/11/2013   714212835   800
    berry   9/8/2013    9/12/2013   816243240   900
    berry   9/9/2013    9/13/2013   918273645   1000
    apple   9/10/2013   9/14/2013   10203040    1100

前月 (この場合は - 9/1/13 - 9/30/13) のリンゴ、ベリー、またはチェリーのいずれかを示すすべての行をコピーして、対応するシートに配置するように Excel を取得しようとしています。シート名はアップル、ベリー、チェリーです。次に、行を挿入し、その行をデータのある最後の行の後の行に追加します。また、対応するシートにコピーする前に、列 a のシリーズの次の番号を生成する必要があります。したがって、行 6 の列 a には数値 6 が含まれます。

いくつかの VBA コードを試してみましたが、「apple」だけでなくすべてのシート名を動的に検索するのに問題があります。また、データのある最後の行を見つけるのに苦労しています。私のコードの下を見てください：

Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long

endRow = 15
pasteRowIndex = 1

For r = 1 To endRow

    If Cells(r, Columns("B").Column).Value = "apple" Then


        Rows(r).Select
        Selection.Copy


        Sheets("apple").Select
        Rows(pasteRowIndex).Select
        ActiveSheet.Paste


        pasteRowIndex = pasteRowIndex + 1



        Sheets("Sheet1").Select
    End If
Next r
End Sub
4

1 に答える 1

1

コードを修正したので、行を 1 つずつコピーする代わりに、適用可能な範囲全体を一度にコピーして自動フィルター処理します。また、これは、「Sheet1」という名前以外のワークシートが検索およびコピー基準として使用されることを前提としています。

Application.CutCopyMode = False

Dim r As Long, c As Long
Dim ws As Worksheet
Dim sFruit As String
Dim wsRow as Long

Worksheets("Sheet1").Activate
r = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row 'find last row
c = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column 'find last column
Range("A1").AutoFilter
Range("C1:C" & r).AutoFilter Field:=3, Criteria2:=Array(1, "9/30/2013") 'filters for month of Sep'13

For Each ws In Worksheets
    If ws.Name <> "Sheet1" Then
        '*edited to accommodate pre-existing data
        ws.Activate '*activate sheet so you can use Cells() with it
        wsRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row + 1 '*find first usable row in ws
        sFruit = ws.Name 'criteria to look for
        Worksheets("Sheet1").Activate 'bring focus back to main sheet
        Range("B1:B" & r).AutoFilter Field:=2, Criteria1:=sFruit
        Range(Cells(2, 1), Cells(r, c)).SpecialCells(xlCellTypeVisible).Copy ws.Range("A" & wsRow)
    End If
Next ws

Range("A1").AutoFilter

Application.CutCopyMode = True

日付でフィルタリングする機能を追加できます。コードを変更する方法を理解できるように、オートフィルターを使用して自分自身を記録することをお勧めします。

于 2013-10-05T16:15:56.900 に答える