Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
9606 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【26342】売上の一覧を販売者単位でシートに集計する yasu 05/7/2(土) 8:32 質問[未読]
【26343】Re:売上の一覧を販売者単位でシートに集計... ぴかる 05/7/2(土) 8:41 発言[未読]
【26346】Re:売上の一覧を販売者単位でシートに集計... yasu 05/7/2(土) 9:34 質問[未読]
【26347】Re:売上の一覧を販売者単位でシートに集計... ぴかる 05/7/2(土) 10:03 発言[未読]
【26351】Re:売上の一覧を販売者単位でシートに集計... yasu 05/7/2(土) 11:53 質問[未読]
【26352】Re:売上の一覧を販売者単位でシートに集計... ぴかる 05/7/2(土) 12:34 発言[未読]
【26356】Re:売上の一覧を販売者単位でシートに集... kobasan 05/7/2(土) 13:49 回答[未読]
【26357】Re:売上の一覧を販売者単位でシートに集... yasu 05/7/2(土) 15:03 質問[未読]
【26359】Re:売上の一覧を販売者単位でシートに集... kobasan 05/7/2(土) 16:11 回答[未読]
【26360】Re:売上の一覧を販売者単位でシートに集... yasu 05/7/2(土) 16:43 お礼[未読]
【26361】Re:売上の一覧を販売者単位でシートに集... kobasan 05/7/2(土) 16:48 回答[未読]
【26363】Re:売上の一覧を販売者単位でシートに集... yasu 05/7/2(土) 18:38 お礼[未読]
【26365】Re:売上の一覧を販売者単位でシートに集... kobasan 05/7/2(土) 19:21 回答[未読]
【26366】Re:売上の一覧を販売者単位でシートに集... kobasan 05/7/2(土) 21:37 回答[未読]
【26369】Re:売上の一覧を販売者単位でシートに集... yasu 05/7/3(日) 9:30 お礼[未読]
【26378】Re:売上の一覧を販売者単位でシートに集... kobasan 05/7/3(日) 22:00 回答[未読]
【26410】Re:売上の一覧を販売者単位でシートに集... yasu 05/7/4(月) 18:16 質問[未読]
【26413】Re:売上の一覧を販売者単位でシートに集... kobasan 05/7/4(月) 19:34 回答[未読]
【26446】Re:売上の一覧を販売者単位でシートに集... yasu 05/7/5(火) 20:08 質問[未読]
【26450】Re:売上の一覧を販売者単位でシートに集... kobasan 05/7/5(火) 21:01 回答[未読]
【26458】Re:売上の一覧を販売者単位でシートに集... yasu 05/7/5(火) 22:39 お礼[未読]
【26342】売上の一覧を販売者単位でシートに集計す...
質問  yasu  - 05/7/2(土) 8:32 -
引用なし
パスワード
   売り上げの集計を月単位で個人別にしたく思います。
毎日の売上は伝票が入り次第、「売上表」に棒打ち入力しています。
そのため若干日付が前後するような場合もあります。行数は1ケ月に約2500行を使用しています。

売上表
月日　　　　氏名　　　　売上
7月1日　　　　AA　　　　10
7月1日　　　　BB　　　　20
7月3日　　　　CC　　　　30
7月4日　　　　AA　　　　10
7月5日　　　　BB　　　　20
7月4日　　　　CC　　　　30
7月7日　　　　AA　　　　10
7月8日　　　　BB　　　　20
7月10日　　　　CC　　　　30
7月9日　　　　AA　　　　10
7月11日　　　　BB　　　　20
7月12日　　　　CC　　　　30
･
･
合計　　　　　　　240

氏名は200名ほどあります。月により若干前後します。
月末には個人別にシート単位に振り分けて集計したいのですが
どのようにすると良いのでしょうか。
月の中ほどでもシート単位で集計する事もあり、シートが常時上書きでき、尚且つ
新規の氏名が発生する場合にも対応できるようにしたいのですが。
またシートには、それぞれ氏名をつけたいのです。
欲張った内容では有りますが、一部でもご教授いただければお願いします。
【26343】Re:売上の一覧を販売者単位でシートに集...
発言  ぴかる  - 05/7/2(土) 8:41 -
引用なし
パスワード
   yasuさん、おはようございます。

データ→ピボットテーブルを使ってみてはどうですか？
いろんな集計が出来ますよ。
【26346】Re:売上の一覧を販売者単位でシートに集...
質問  yasu  - 05/7/2(土) 9:34 -
引用なし
パスワード
   ▼ぴかる さん：

おはようございます。早速のアドバイスありがとうございます。
ピボットテーブルは誰にでも操作できない･･･エクセルの体験者で
無いと、と思いました。
実は、２００シートの連続印刷の必要性や操作が誰にでもできる
必要があり、Macroで操作できないか検討中なのです。

これからもアドバイスお願いします。
現在氏名を連続的にピックアップさせるところと
シートを順次名前を変えていくところの変数をどのように進めたら
良いか悩んでおります。何かアドバイスをいただければ幸いです。


Sub Macro1()

　Sheets("売上一覧").Activate
　　Selection.AutoFilter Field:=2, Criteria1:=Range("E1")　'氏名をE1に入れて
　　'ていますが、これを連続的に名前を変える方法がありましたら教えてください。
　　Sheets("AA").Select　'シートの名前を変える方法を教えてください。
　　Range("A1").Select
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
　Sheets("売上一覧").Activate
　　Selection.AutoFilter
　　Range("A1").Select
　　
End Sub
【26347】Re:売上の一覧を販売者単位でシートに集...
発言  ぴかる  - 05/7/2(土) 10:03 -
引用なし
パスワード
   >実は、２００シートの連続印刷の必要性や操作が誰にでもできる
>必要があり、Macroで操作できないか検討中なのです。
２００シートですか・・・。大変ですね。あまり状況が分かりませんが、
データベースシートと抽出シートの２つでいけるかもしれませんね。
各個人ずつ抽出・印刷をしていくのが効率的かなと思います。

氏名欄を作成し、そこをFor〜Nextで氏名を取得し
>　　Selection.AutoFilter Field:=2, Criteria1:=Range("E1")　
Range("E1")を変数に変更すればいいと思います。

>　　Sheets("AA").Select　'シートの名前を変える方法を教えてください。
マクロ記録してみましょう。
【26351】Re:売上の一覧を販売者単位でシートに集...
質問  yasu  - 05/7/2(土) 11:53 -
引用なし
パスワード
   ▼ぴかる さん：

>氏名欄を作成し、そこをFor〜Nextで氏名を取得し
>Range("E1")を変数に変更すればいいと思います。

アドバイスありがとうございました。
氏名の変数をピックアップしてそれぞれその氏名の
売上をコピーするところまで出来ました。

後は対象データを新しいシートに転記することで
解決が出来ません。
シートAAに絞り込んだデータが順次入る状態です。
シートを変えていく変数のやりかたをご指導の
程お願いします。

現在のマクロの状態は以下のとおりです。
一度見てください。

Sub 順次選択貼り付け()


　　Sheets("売上一覧").Select
　　Range("B2", Cells(65536, 2).End(xlUp)).Select
　　Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
　　Selection.SpecialCells(xlCellTypeVisible).Copy
　　Range("Z3000").Select
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
　　
　　Dim i As Integer
　　For i = Cells(65536, 26).End(xlUp).Row To 3001 Step -1
　　Range("E1") = Cells(i, 26).Value '絞り込んだ氏名を明示
　　
　　Sheets("売上一覧").Activate
　　Range("A2").AutoFilter Field:=2, Criteria1:=Range("E1")
　　Range("A2").CurrentRegion.Select
　　Selection.Copy

　　Sheets("AA").Select　　'←ここのところの変数をどのようにすると
　　　　　　　　　　　　　　　'良いのでしょうか？
　　Range("A2").Select
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
　　Sheets("売上一覧").Activate
　　Selection.AutoFilter
　　Range("A1").Select
　　
　　Next
　　
　　Range("A1").Select
End Sub
【26352】Re:売上の一覧を販売者単位でシートに集...
発言  ぴかる  - 05/7/2(土) 12:34 -
引用なし
パスワード
   >後は対象データを新しいシートに転記することで
>解決が出来ません。
>シートAAに絞り込んだデータが順次入る状態です。
>シートを変えていく変数のやりかたをご指導の
>程お願いします。
こういう事をするのでしょうか？
新規シート作成→シート名入力→データコピー
これならマクロ記録して下さい。
手動入力したシート名を変数に置き換えて下さい。

本日、休日出勤中でしてこれ以上の対応が難しくなってきました。お許しを・・・。
【26356】Re:売上の一覧を販売者単位でシートに集...
回答  kobasan  - 05/7/2(土) 13:49 -
引用なし
パスワード
   ▼yasu さん　今日は。

別解ですが参考にしてください。
E1にデータ入れなくてもよくなっています。

Option Explicit
Private OrgSheet As String

Sub 名別にシート貼付け()
Dim Filterkey As String
Dim c As Range
Dim X() As Variant
Dim n As Long, i As Long
　　OrgSheet = "Sheet1"　 '<=="Sheet1"を "売上一覧"に置き換え
　　Application.ScreenUpdating = False
　　'-----2列目の無重複データ作成
　　With Sheets(OrgSheet)
　　　　n = 0
　　　　For Each c In Range("B2", Sheets(OrgSheet).Cells(65535, 2).End(xlUp))
　　　　　　If Application.CountIf(.Range("B2", c), c.Value) = 1 Then
　　　　　　　　n = n + 1
　　　　　　　　ReDim Preserve X(1 To n)
　　　　　　　　X(n) = c.Value
　　　　　　End If
　　　　Next
　　End With
　　'-----抽出・コピー・貼付
　　For i = 1 To UBound(X)
　　　　'-----抽出・コピー
　　　　Filterkey = X(i)
　　　　del_sheet Filterkey
　　　　Sheets(OrgSheet).Select
　　　　Range("A2").AutoFilter Field:=2, Criteria1:=Filterkey
　　　　Range("A1").CurrentRegion.Offset(1).Copy
　　　　'-----貼付
　　　　ActiveWorkbook.Worksheets.Add.Name = Filterkey
　　　　Sheets(Filterkey).Cells(1, 1).PasteSpecial Paste:=xlAll
　　　　'　　　　　　　　　　　.PasteSpecial Paste:=xlValues
　　　　'-----小計を格納
　　　　Set c = Sheets(Filterkey).Cells(65535, 1).End(xlUp)
　　　　c.Offset(1, 0) = "計"　'<<<変更
　　　　小計 c
　　　　Sheets(OrgSheet).AutoFilterMode = False　　'AutoFilterの解除
　　Next

　　Application.CutCopyMode = False　　 'CopyModeの解除
　　Set c = Nothing
End Sub

Sub 小計(c As Range)
　　c.Offset(1, 3) = Application.Subtotal(9, Sheets(OrgSheet).Columns(4))
End Sub

Sub del_sheet(Filterkey As String)
　　On Error Resume Next
　　Application.DisplayAlerts = False
　　Sheets(Filterkey).Delete
　　On Error GoTo 0
　　Application.DisplayAlerts = True
End Sub
【26357】Re:売上の一覧を販売者単位でシートに集...
質問  yasu  - 05/7/2(土) 15:03 -
引用なし
パスワード
   ▼kobasan さん：

ご解答ありがとうございます。
これからエクセルに貼り付け操作させていただきます。
E1にデータを入れなくて良いのですか！
ありがとうございました。
>別解ですが参考にしてください。
>E1にデータ入れなくてもよくなっています。

kobasan さん。少し時間を割いていただけませんでしょうか。
何とか私なりに、仕上げたのですが。
上書きが出来ない欠点があります。
２回マクロを使うとエラーになります。
私のコードを見ていただき、コードの訂正をしていただけませんでしょうか。
不躾なお願いをお許しください。

時間が有りましたら、是非よろしくお願いします。

Sub 売上氏名単位集計()

　　Dim i As Integer
　　Dim St_Name As String
　　Dim シート数 As Integer
　　シート数 = Sheets.Count

　　Sheets("売上一覧").Select　　　'対象種類を絞り込む
　　　　Range("B2", Cells(65536, 2).End(xlUp)).Select
　　　　Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
　　　　Selection.SpecialCells(xlCellTypeVisible).Copy
　　　　Range("Z3000").Select
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
　　
　　Range("A1").Select
　
　　For i = Cells(65536, 26).End(xlUp).Row To 3001 Step -1
　　Range("E1") = Cells(i, 26).Value　 '絞り込んだ対象を順次明示
　　St_Name = Range("E1")
　　
　　Sheets("売上一覧").Activate
　　Range("A2").AutoFilter Field:=2, Criteria1:=Range("E1")
　　Range("A2").CurrentRegion.Select
　　Selection.Copy
　　
　　Sheets.Add before:=Sheets(シート数)

　　Sheets(シート数).Name = St_Name
　　
　　Range("A2").Select
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
　　Sheets("売上一覧").Activate
　　Selection.AutoFilter
'　　Range("A1").Select
'
　　Next
　　
　　Range("A1").Select
End Sub
【26359】Re:売上の一覧を販売者単位でシートに集...
回答  kobasan  - 05/7/2(土) 16:11 -
引用なし
パスワード
   ▼yasu さん 今日は

これでできるとおもいます。

>
>ご解答ありがとうございます。
>これからエクセルに貼り付け操作させていただきます。
>E1にデータを入れなくて良いのですか！
>ありがとうございました。
>>別解ですが参考にしてください。
>>E1にデータ入れなくてもよくなっています。
>
>kobasan さん。少し時間を割いていただけませんでしょうか。
>何とか私なりに、仕上げたのですが。
>上書きが出来ない欠点があります。
>２回マクロを使うとエラーになります。
>私のコードを見ていただき、コードの訂正をしていただけませんでしょうか。
>不躾なお願いをお許しください。
>
>時間が有りましたら、是非よろしくお願いします。
>
>Sub 売上氏名単位集計()
>
>　　Dim i As Integer
>　　Dim St_Name As String
>　　Dim シート数 As Integer
>　　シート数 = Sheets.Count
>
>　　Sheets("売上一覧").Select　　　'対象種類を絞り込む
>　　　　Range("B2", Cells(65536, 2).End(xlUp)).Select
>　　　　Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
>　　　　Selection.SpecialCells(xlCellTypeVisible).Copy
>　　　　Range("Z3000").Select
>　　ActiveSheet.Paste
>　　Application.CutCopyMode = False
>　　
>　　Range("A1").Select
>　
>　　For i = Cells(65536, 26).End(xlUp).Row To 3001 Step -1
>　　Range("E1") = Cells(i, 26).Value　 '絞り込んだ対象を順次明示
>　　St_Name = Range("E1")

　　del_sheet St_Name　'<=======追加
>　　
>　　Sheets("売上一覧").Activate
>　　Range("A2").AutoFilter Field:=2, Criteria1:=Range("E1")
>　　Range("A2").CurrentRegion.Select
>　　Selection.Copy

　　Sheets.Add before:=Sheets(シート数 - 1)　'<=======修正

　　Sheets(シート数 - 1).Name = St_Name　'<=======修正

>　　
>　　Range("A2").Select
>　　ActiveSheet.Paste
>　　Application.CutCopyMode = False
>　　Sheets("売上一覧").Activate
>　　Selection.AutoFilter
>'　　Range("A1").Select
>'
>　　Next
>　　
>　　Range("A1").Select
>End Sub

'============以下追加

Sub del_sheet(St_Name As String)
　　On Error Resume Next
　　Application.DisplayAlerts = False
　　Sheets(St_Name).Delete
　　On Error GoTo 0
　　Application.DisplayAlerts = True
End Sub
【26360】Re:売上の一覧を販売者単位でシートに集...
お礼  yasu  - 05/7/2(土) 16:43 -
引用なし
パスワード
   ▼kobasan さん：

今晩は

ありがとうございました。無事マクロがほぼ完成しました。
追加・修正の意味が未だ分かりませんが、これから理解して行きます。
特に「Sub del_sheet(St_Name As String)」が分かりません。

貴重な時間を割いていただきありがとうございました。

一方、貴兄の作成いただいたコードですが

With Sheets(OrgSheet)の部分で止まってしまいます。
小生には、直す方法がわかりません。ご報告まで。
【26361】Re:売上の一覧を販売者単位でシートに集...
回答  kobasan  - 05/7/2(土) 16:48 -
引用なし
パスワード
   ▼yasu さん：
>▼kobasan さん：
>
>今晩は
>
>ありがとうございました。無事マクロがほぼ完成しました。
>追加・修正の意味が未だ分かりませんが、これから理解して行きます。
>特に「Sub del_sheet(St_Name As String)」が分かりません。
>
>貴重な時間を割いていただきありがとうございました。
>
>一方、貴兄の作成いただいたコードですが
>
> With Sheets(OrgSheet)の部分で止まってしまいます。
>小生には、直す方法がわかりません。ご報告まで。
Option Explicit
Private OrgSheet As String

Sub 名別にシート貼付け()
Dim Filterkey As String
Dim c As Range
Dim X() As Variant
Dim n As Long, i As Long
　　OrgSheet = "Sheet1"　 '<=="Sheet1"を "売上一覧"に置き換え
　　　　　　　　↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑
　　　　　　　　　"Sheet1"を "売上一覧"に置き換えてください。
【26363】Re:売上の一覧を販売者単位でシートに集...
お礼  yasu  - 05/7/2(土) 18:38 -
引用なし
パスワード
   ▼kobasan さん：

最終まで色々とご指導ありがとうございました。
大変勉強になりました。
また貴兄の作成されたマクロは非常に早く展開する事も
実感しました。合計が０でしたが・・・

又質問が出てきました。
月日　　　氏名　　　　売上
7月1日　　　　AA　　　　10
7月1日　　　　BB　　　　20
7月3日　　　　CC　　　　　30
7月4日　　　　AA　　　　10
7月5日　　　　BB　　　　20
7月4日　　　　CC　　　　　30
7月7日　　　　AA　　　　10
7月8日　　　　BB　　　　20
7月10日　　　　CC　　　　　30
7月9日　　　　AA　　　　10
7月11日　　　　BB　　　　20
7月12日　　　　CC　　　　　30
7月13日　　　　DD　　　　40
7月14日　　　　FF　　　　50
7月22日　　　　KK　　　　100
　　　　　　　　　430

売上の一番下にsubtotal（430）を入れたいのですが、行が
増えても売上の一番下にSubtotalをしたいのですが
固定のマクロはできるのですが
＝(イコール）以下の書き方を教えていただけませんでしょうか？
Sub Macro1()
　　
　　Range("C65536").End(xlUp).Offset(1).FormulaR1C1 = "=SUBTOTAL(9,R[-13]C:R[-1]C)"
　　
End Sub

また、ここまで出来ると、欲が出てきて全ページ（シート）全てを順次印刷する
別のマクロを考えたいと思っています。しばらくこれもかかるかと
思いますが、ヒントをいただければ幸いです。
本当にありがとうございました。御礼まで。
【26365】Re:売上の一覧を販売者単位でシートに集...
回答  kobasan  - 05/7/2(土) 19:21 -
引用なし
パスワード
   ▼yasu さん　今晩は。

>実感しました。合計が０でしたが・・・

>売上の一番下にsubtotal（430）を入れたいのですが、行が
>増えても売上の一番下にSubtotalをしたいのですが

小計の列がずれていましたので訂正します。

Sub 小計(c As Range)のところを以下のように直してください。
これでうまくできます。

Sub 小計(c As Range)
　　c.Offset(1, 2) = Application.Subtotal(9, Sheets(OrgSheet).Columns(3))
End Sub

>＝(イコール）以下の書き方を教えていただけませんでしょうか？
>Sub Macro1()
>　　
>　　Range("C65536").End(xlUp).Offset(1).FormulaR1C1 = "=SUBTOTAL(9,R[-13]C:R[-1]C)"
>　　
>End Sub
>

このコードのやり方では、転記したシート名が変化するのでコードが複雑になります。
よって、転記したシートで小計は出さない方がいいです。
Sub 小計(c As Range)は元のシートで小計を出していますので、シート名の扱いが楽
になっています。
【26366】Re:売上の一覧を販売者単位でシートに集...
回答  kobasan  - 05/7/2(土) 21:37 -
引用なし
パスワード
   ▼yasu さん 今晩は。

>売上の一番下にsubtotal（430）を入れたいのですが、行が
>増えても売上の一番下にSubtotalをしたいのですが
>固定のマクロはできるのですが
>＝(イコール）以下の書き方を教えていただけませんでしょうか？
>Sub Macro1()
>　　
>　　Range("C65536").End(xlUp).Offset(1).FormulaR1C1 = "=SUBTOTAL(9,R[-13]C:R[-1]C)"
>　　
>End Sub


これを動くようにしたのが、下記コードです。
呼び出し方は、いままでの本体のプロージャの中に、呼び出したいところに

　　小計 ST_Name

を入れて呼び出します。

Sub 小計(ST_Name As String)
Dim LastC As Range
　　Set LastC = Sheets(ST_Name).Range("C65536").End(xlUp)
　　LastC.Offset(1).FormulaR1C1 = "=SUBTOTAL(9,R[-" & LastC.Row & "]C:R[-1]C)"
End Sub
【26369】Re:売上の一覧を販売者単位でシートに集...
お礼  yasu  - 05/7/3(日) 9:30 -
引用なし
パスワード
   ▼kobasan さん：
おはようございます。
Subtotalのコードありがとうございました。無事、やりたい内容が出来たように思います。

今回kobasanさんから沢山のことを学びました。ありがとうございました。
これからもよろしくお願いします。
大変喜んでおります。特に上書きができることに関してはマクロが実用化にぐっと近づいた事を実感できました。

>これを動くようにしたのが、下記コードです。
>呼び出し方は、いままでの本体のプロージャの中に、呼び出したいところに
>
>　　小計 ST_Name
>
>を入れて呼び出します。
>
>Sub 小計(ST_Name As String)
>Dim LastC As Range
>　　Set LastC = Sheets(ST_Name).Range("C65536").End(xlUp)
>　　LastC.Offset(1).FormulaR1C1 = "=SUBTOTAL(9,R[-" & LastC.Row & "]C:R[-1]C)"
>End Sub

このようなマクロは個別に処理した方が良いのでしょうか。
動作が分かりやすいと理解しましたが、思いつきません。これから少しずつ学んで生きます。
本当にお忙しいところ、ずっと最後までありがとうございました。
【26378】Re:売上の一覧を販売者単位でシートに集...
回答  kobasan  - 05/7/3(日) 22:00 -
引用なし
パスワード
   ▼yasu さん　今晩は。

>>Sub 小計(ST_Name As String)
>>Dim LastC As Range
>>　　Set LastC = Sheets(ST_Name).Range("C65536").End(xlUp)
>>　　LastC.Offset(1).FormulaR1C1 = "=SUBTOTAL(9,R[-" & LastC.Row & "]C:R[-1]C)"
>>End Sub
>
>このようなマクロは個別に処理した方が良いのでしょうか。
>動作が分かりやすいと理解しましたが、思いつきません。

このホームページに出ておられる方に比べれば、私は、まだま序の口みたいなものですが。

小さなプロージャを使うかどうかは、十人十色で好みだと思います。

　私は、長々としたプログラムは、結構メンテナンスと後からみても分かるという点では、
あまり使いません。
　小さな部品を沢山ためておいて、やりたいことが決まれば、今までに作った部品を利用して
プログラムを作っています。とくに難しそうなコードのときは役立ちます。

そのために、私は小さなプロージャを部品化して、Excelの部品フォルダに集めています。

たとえば、これなどは、

>Sub 小計(ST_Name As String)
>Dim LastC As Range
>　　Set LastC = Sheets(ST_Name).Range("C65536").End(xlUp)
>　　LastC.Offset(1).FormulaR1C1 = "=SUBTOTAL(9,R[-" & LastC.Row & "]C:R[-1]C)"
>End Sub

FormulaR1C1_SUBTOTALなどの名前を付けて部品化しています。
一つの機能ごとに部品化しておくと、後から分かりやすいし、使いやすいです。

今回のコードもためておいた部品を活用しています。
とにかく自分がやりやすいようにやればいいと思います。

では、また何かあれば、そのときということで。
【26410】Re:売上の一覧を販売者単位でシートに集...
質問  yasu  - 05/7/4(月) 18:16 -
引用なし
パスワード
   ▼kobasan さん：

ありがとうございました。
メンテナンスから考えると確かに、貴兄のコードは分かり
やすと思いました。。
>
>私は、長々としたプログラムは、結構メンテナンスと後からみても分かるという点で>>>は、
>あまり使いません。

部品の管理なども良いアイディアと思います。
私も見習いたいとは思いますが、どのような管理が後で探しやすいか？
でしょうね。分類の仕方の理解（つまり未だマクロの理解度が低いため）を
少しずつ勉強して行きます。

>では、また何かあれば、そのときということで。

ありがとうございます。

又質問があるのですが･･･宜しいでしょうか。

シートの印刷をコードにしたのですが、何故かスピードが遅いような感じが
しますが、一度目を通していただけませんでしょうか。

Sub プリントアウト()

　　Application.ScreenUpdating = False

　　Dim i As Integer
　　Dim ST_Name As String
　　Sheets("売上一覧").Activate

　　　 For i = 3001 To Cells(65536, 26).End(xlUp).Row
　　　
　　　Sheets("売上一覧").Activate

　　　Range("E1") = Cells(i, 26).Value

　　ST_Name = Range("E1")

　　Sheets(ST_Name).Select
　　
　　 With ActiveSheet.PageSetup
　　
　　　　.PrintArea = Range(Range("B2"), Range("B2").CurrentRegion.Offset(2)).Address
　　 End With

'　　 ActiveWindow.SelectedSheets.PrintOut Copies:=1
　　
　　Next
　　
　　Sheets("売上一覧").Activate
　　
　　Application.ScreenUpdating = True

　
End Sub
【26413】Re:売上の一覧を販売者単位でシートに集...
回答  kobasan  - 05/7/4(月) 19:34 -
引用なし
パスワード
   ▼yasu さん：


>又質問があるのですが･･･宜しいでしょうか。
>
>シートの印刷をコードにしたのですが、何故かスピードが遅いような感じが
>しますが、一度目を通していただけませんでしょうか。

>　　 With ActiveSheet.PageSetup　
>　　　　.PrintArea = Range(Range("B2"), Range("B2").CurrentRegion.Offset(2)).Address
>　　 End With
>'　　 ActiveWindow.SelectedSheets.PrintOut Copies:=1

PageSetup.PrintArea やPrintOutなど出力に関する部分は時間のかかるものです。
印刷イメージを作成するには時間がかかりますし、印刷自体も時間かかります。
（出力関係でいうと、ファイルの保存、画面表示も時間がかかります。）
プログラムで解決できる部分ではないのです。印刷を速く終えるには、パワーのある
レーザープリンターを使うのが一番の方法でしょう。
【26446】Re:売上の一覧を販売者単位でシートに集...
質問  yasu  - 05/7/5(火) 20:08 -
引用なし
パスワード
   ▼kobasan さん：
今晩は。
ロングランの質問にいつも丁寧にご返事いただきありがとうございました。
これからもよろしくご指導の程お願いします。
あと一つご質問させていただきたいのですが･･･

貴兄から頂きましたコードで
Sheets.Add before:=Sheets(シート数 - 1)

　　Sheets(シート数 - 1).Name = ST_Name
の部分ですが、
シートがメインのシート（「売上一覧」だけ）だけの時に
この部分で、エラーがでます。
現在、このメインシート以外に一枚シートを作って「予備」(名前は何でも
良いようですが）という名前でシートを二枚にしておくと問題なくマクロが
作動してくれます。これで当分使用しますが、この予備のシートを外す
ためのマクロにするにはどのようにすると良いのでしょうか？

if を使って場合分けをしたのですが･･･だめでした
次のようなコードを書いたのですが、何処を訂正すれば良いか
もしご解答いただけるようでしたらお願いします。
本当にありがとうございました。失礼します。

　　On Error Resume Next

　　If Sheets(シート数) > 1 Then　
　　Sheets.Add before:=Sheets(シート数 - 1)

　　Sheets(シート数 - 1).Name = ST_Name
　　Error.Clear
　　Else　　　
　　Sheets.Add before:=Sheets(シート数)

　　Sheets(シート数).Name = ST_Name
　　End If
【26450】Re:売上の一覧を販売者単位でシートに集...
回答  kobasan  - 05/7/5(火) 21:01 -
引用なし
パスワード
   ▼yasu さん　　今晩は。

>シートがメインのシート（「売上一覧」だけ）だけの時に
>この部分で、エラーがでます。
>現在、このメインシート以外に一枚シートを作って「予備」(名前は何でも
>良いようですが）という名前でシートを二枚にしておくと問題なくマクロが
>作動してくれます。これで当分使用しますが、この予備のシートを外す
>ためのマクロにするにはどのようにすると良いのでしょうか？
>
>if を使って場合分けをしたのですが･･･だめでした
>次のようなコードを書いたのですが、何処を訂正すれば良いか
>もしご解答いただけるようでしたらお願いします。
>本当にありがとうございました。失礼します。

【26359】のこーどで

>Sub 売上氏名単位集計()
>
>　　Dim i As Integer
　　Dim St_Name As String
　　Dim シート数 As Integer　'<=======削除してください

　　シート数 = Sheets.Count　'<=======削除削除してください
　　　　　・
　　　　　・
　　　　　・
　　　　　・
>　　Sheets.Add before:=Sheets(シート数 - 1)　'<=======修正
>　　　　　　　　　　　　　　　~~~~~~~~~~~~~~~~~~~~~~
>　　Sheets(シート数 - 1).Name = St_Name　'<=======修正
　　　~~~~~~~~~~~~~~~~~~~~~~
を
　　Sheets.Add before:=Sheets(Sheets.Count)
'　　　　　　　　　　　　　　~~~~~~~~~~~~~~~~~~~~~~
　　Sheets(Sheets.Count).Name = St_Name
'　　~~~~~~~~~~~~~~~~~~~~~~
に置き換えてください。
これで予備のシートを外すことができます。
修正が適切でなくて、すみませんでした。
【26458】Re:売上の一覧を販売者単位でシートに集...
お礼  yasu  - 05/7/5(火) 22:39 -
引用なし
パスワード
   ▼kobasan さん：

ありがとうございました。
これで、分からない点、疑問な点の全てが解決しました。
喉につかえていたものがすっきりした感じです。

本当に親切なご指導ありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
9606 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free