| |
▼通りすがりの達人 さん：
ちょっと勉強を兼ねてコードを作ってみました。
seet3(工事台帳？)がアクティブな状態からの実行を想定してます。
>実は、seet3の工事台帳の物件は５００件程度、１物件あたりの設定は１０００行
>となっていて、かなりのボリュームになります。
結果どうしたいのかが、いまいち理解できなかったので、もしかすると
とんちんかんなものになってるかもしれません。
Sub sub_sample3()
'Seet3（工事台帳？から実行）
Dim myRange As Range
'旧データのクリア
' Sheets("Seet3").Range("A5:D" & Cells.Rows.Count).ClearContents
Range("A5:D" & Cells.Rows.Count).ClearContents
With Worksheets("Seet1")
.Range("A1").AutoFilter '念の為
Set myRange = .Range(.Cells(2, 1), _
.Cells(.Cells.Rows.Count, 1).End(xlUp))
'データの抽出
.Range("A1").AutoFilter Field:=2, Criteria1:=Range("A1").Value
End With
'コピー
On Error Resume Next
myRange.SpecialCells(xlCellTypeVisible).Copy Range("A5")
myRange.Resize(, 2).Offset(, 3) _
.SpecialCells(xlCellTypeVisible).Copy Range("B5")
On Error GoTo 0
'フィルタ解除
Worksheets("Seet1").Range("A1").AutoFilter
'累計の式挿入
Set myRange = Range("C" & Cells.Rows.Count).End(xlUp)
If myRange.Row <= 4 Then
MsgBox "抽出データ無し"
Exit Sub
ElseIf myRange.Row = 5 Then
Range("D5").Value = "=C5"
Else
Range("D5").FormulaR1C1 = "=RC[-1]"
Range("D6:D" & myRange.Row).FormulaR1C1 = "=R[-1]C+RC[-1]"
End If
MsgBox "終了"
End Sub
私自身の勉強を兼ねたので、分かりにくい部分があるかもしれませんが、
ご了承下さい。
(^･ω･^)
|
|
飛ばない豚
- 06/9/5(火) 15:39 -
