Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

57348 / 76738

←次へ　｜　前へ→


	【24127】Re:検索　転記　合計値

YN61 - 05/4/12(火) 18:13 -


	引用なし

	パスワード

▼momomi さん：
こんにちは

そしてkobasanさん(色々とありがとうございました）
こんにちは…

会社で。ひおひねりしてきました。
シート３に集計しています。

一度これも試して見てください。できるだけシンプルにしようとしました。

Sub 検索転記小計合計()

　Sheets(3).Select
　　 Range("B2").Select
　　 Selection.RemoveSubtotal
　　 Columns("A:G").Select
　　 Selection.ClearContents
　　 Range("A1").Select
　Sheets(1).Select
　　 Range("A1").Select
　　 Selection.CurrentRegion.Select
　　 Selection.Copy
　Sheets(3).Select
　　 Range("A1").Select
　　 ActiveSheet.Paste
　　 Range("B2").Select

　　 Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
　　　　 OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
　　　　 :=xlPinYin
　　 Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(5, 6, 7), _
　　　　Replace:=True, PageBreaks:=False, SummaryBelowData:=True
　　 Range("A1").Select
　　 Selection.CurrentRegion.Select
　　　　 With Selection.Borders '(xlEdgeLeft)
　　　　.LineStyle = xlContinuous
　　　　.Weight = xlThin
　　　　.ColorIndex = xlAutomatic
　　　　End With
　　 Range("A1").Select
'　Sheets(1).Select
'　　 Range("A1").Select
End Sub

0 hits

▼

【23981】検索　転記　合計値 momomi 05/4/9(土) 0:25