08/09/15 16:03:53
>>247
Sub Sample()
Dim K_Ban As Long: K_Ban = Worksheets("メイン画面").Range("B5")
Dim r As Long
Dim shubetsu As String
Dim shubetsuCnt As Integer
With ThisWorkbook.Sheets("情報Ｂ")
.Range(.Cells(1, 1), .Cells(.Rows.Count, 4).End(xlUp)).AutoFilter Field:=1, Criteria1:=K_Ban
r = 2
Do While .Cells(r, 1) <> ""
If .Rows(r).Hidden = False Then
If shubetsu <> .Cells(r, 2) Then
shubetsu = .Cells(r, 2)
shubetsuCnt = 1
ElseIf shubetsuCnt < 3 Then
shubetsuCnt = shubetsuCnt + 1
Else
.Rows(r).Hidden = True
End If
End If
r = r + 1
Loop
.Range(.Cells(2, 1), .Cells(.Rows.Count, 4).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
Destination:=ThisWorkbook.Sheets("メイン画面").Cells(8, 3) '←任意のコピー先セル
.AutoFilterMode = False
End With
End Sub