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 -

引用なし
パスワード
   ▼ぴかる さん:

おはようございます。早速のアドバイスありがとうございます。
ピボットテーブルは誰にでも操作できない・・・エクセルの体験者で
無いと、と思いました。
実は、200シートの連続印刷の必要性や操作が誰にでもできる
必要があり、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 -

引用なし
パスワード
   >実は、200シートの連続印刷の必要性や操作が誰にでもできる
>必要があり、Macroで操作できないか検討中なのです。
200シートですか・・・。大変ですね。あまり状況が分かりませんが、
データベースシートと抽出シートの2つでいけるかもしれませんね。
各個人ずつ抽出・印刷をしていくのが効率的かなと思います。

氏名欄を作成し、そこを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 さん。少し時間を割いていただけませんでしょうか。
何とか私なりに、仕上げたのですが。
上書きが出来ない欠点があります。
2回マクロを使うとエラーになります。
私のコードを見ていただき、コードの訂正をしていただけませんでしょうか。
不躾なお願いをお許しください。

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

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 さん。少し時間を割いていただけませんでしょうか。
>何とか私なりに、仕上げたのですが。
>上書きが出来ない欠点があります。
>2回マクロを使うとエラーになります。
>私のコードを見ていただき、コードの訂正をしていただけませんでしょうか。
>不躾なお願いをお許しください。
>
>時間が有りましたら、是非よろしくお願いします。
>
>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 さん:

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

又質問が出てきました。
月日   氏名    売上
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 さん 今晩は。

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

>売上の一番下に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