Excel VBA質問箱 IV

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

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


52464 / 76732 ←次へ | 前へ→

【29106】Re:ワークシート間の検索集計
お礼  toki  - 05/9/24(土) 23:14 -

引用なし
パスワード
   ▼ponpon さん:
ponponさんこんばんは。

いつもありがとうございます。
同様のループを考えて試しておりました。コード内容はほぼ同じような構成でやってます。

.Cells(3, 8).End(xlToLeft).Offset(0, 1).Resize(5, 1).Value = Application.Transpose(myTen1)のところなのですが、この場合右側の空白列を順番に各月のデータで埋めていくループになると認識しております。

そうするとヒューマンエラーで万が一、データが残ってしまった場合などを考えると、全部ずれていくような気がしております。

これが原因かはわかりませんが、実際に試している最中に、月がずれてしまう現象が起こりました。
前のデータが残っていたか、消し忘れがあったのかもしれません。

本当は、ループ処理が理想なのですが、今回のマクロは、人事考課用の点数集計表に使用する予定のため間違いが起こらない仕様にしなくてはならないので、各月の各ブロックの第1セルは直接指定することにしました。
そのうえで、ponponさんからの教えに基づきApplication.Transposeを使用して行、列の入れ替え処理をするように改良しています。

ところでApplication.CutCopyMode = Falseとありますが、これはこのソース内でどういった効果があるのでしょうか?

ponponさんのおかげで非常に勉強になりました。
ありがとうございます。
今後ともよろしくお願いします。

現在までの改良ソースです。
非効率な部分があればご指摘ください。

※点数集計表は人事評価シートと表記されています。
※sentakuI    はユーザーフォームで職務抽出されている変数です。

Private Sub 職務別印刷上期実行ボタン_Click()

  Dim i As Integer, j As Integer
  Dim myAry As Variant
  Dim gyo As Variant
  Dim ten As Variant
  Dim hvten As Variant
  Dim myten1 As Variant, myten2 As Variant
  
  Application.ScreenUpdating = False
   
  '社員登録がされている職務かどうかのチェック
  With Worksheets("4月")
  erCh = Application.Match(sentakuI, .Range("A:A"), 0)
  End With
    
  If 職務別印刷TextBox1.Value = "" Then
    MsgBox "いずれかの職務を選択してください。", vbExclamation, "職務選択"
  ElseIf IsError(erCh) Then
    MsgBox "この職務の社員登録はありません。", vbExclamation, "登録なし"
  
  Else 
   
  '点数集計
  '****************************************
  '職務によるオートフィルター絞込み
  '****************************************
  With Worksheets("4月")
    '4月A列に職務によるオートフィルターをかける
    .Range("A6", .Range("A65536").End(xlUp)).AutoFilter field:=1, Criteria1:=sentakuI
    '抽出されたC列をmyRに格納
    Set myR = .Range("C7", .Range("C65536").End(xlUp)).SpecialCells(xlCellTypeVisible)

    'C列を上から順に(C=社員番号)
    For Each c In myR
      
      '社員番号、社員名書き出し
      With Worksheets("人事評価シート")
        .Range("D3") = c.Offset(0, 0).Value
        .Range("D5") = c.Offset(0, -1).Value
      End With

      '****************************************
      '各月点数コピーペースト
      '****************************************
      '4月
      With Worksheets("4月")
        gyo = Application.Match(c, .Range("C:C"), 0)
        Set ten = .Cells(gyo, 5)
        '点数のコピー
        myten1 = ten.Offset(0, 0).Resize(1, 5).Value 'はじめの5つ
        myten2 = ten.Offset(0, 5).Resize(1, 5).Value '次の5つ
        '人事評価シートへ
        With Worksheets("人事評価シート")
          .Cells(13, 2).Resize(5, 1).Value = Application.Transpose(myten1)
          .Cells(19, 2).Resize(5, 1).Value = Application.Transpose(myten2)
        End With
      End With
      '5月
      With Worksheets("5月")
        gyo = Application.Match(c, .Range("C:C"), 0)
        Set ten = .Cells(gyo, 5)
        '点数のコピー
        myten1 = ten.Offset(0, 0).Resize(1, 5).Value 'はじめの5つ
        myten2 = ten.Offset(0, 5).Resize(1, 5).Value '次の5つ
        '人事評価シートへ
        With Worksheets("人事評価シート")
          .Cells(13, 3).Resize(5, 1).Value = Application.Transpose(myten1)
          .Cells(19, 3).Resize(5, 1).Value = Application.Transpose(myten2)
        End With
      End With
      '6月
      With Worksheets("6月")
        gyo = Application.Match(c, .Range("C:C"), 0)
        Set ten = .Cells(gyo, 5)
        '点数のコピー
        myten1 = ten.Offset(0, 0).Resize(1, 5).Value 'はじめの5つ
        myten2 = ten.Offset(0, 5).Resize(1, 5).Value '次の5つ
        '人事評価シートへ
        With Worksheets("人事評価シート")
          .Cells(13, 4).Resize(5, 1).Value = Application.Transpose(myten1)
          .Cells(19, 4).Resize(5, 1).Value = Application.Transpose(myten2)
        End With
      End With
      '7月
      With Worksheets("7月")
        gyo = Application.Match(c, .Range("C:C"), 0)
        Set ten = .Cells(gyo, 5)
        '点数のコピー
        myten1 = ten.Offset(0, 0).Resize(1, 5).Value 'はじめの5つ
        myten2 = ten.Offset(0, 5).Resize(1, 5).Value '次の5つ
        '人事評価シートへ
        With Worksheets("人事評価シート")
          .Cells(13, 6).Resize(5, 1).Value = Application.Transpose(myten1)
          .Cells(19, 6).Resize(5, 1).Value = Application.Transpose(myten2)
        End With
      End With
      '8月
      With Worksheets("8月")
        gyo = Application.Match(c, .Range("C:C"), 0)
        Set ten = .Cells(gyo, 5)
        '点数のコピー
        myten1 = ten.Offset(0, 0).Resize(1, 5).Value 'はじめの5つ
        myten2 = ten.Offset(0, 5).Resize(1, 5).Value '次の5つ
        '人事評価シートへ
        With Worksheets("人事評価シート")
          .Cells(13, 7).Resize(5, 1).Value = Application.Transpose(myten1)
          .Cells(19, 7).Resize(5, 1).Value = Application.Transpose(myten2)
        End With
      End With
      '9月
      With Worksheets("9月")
        gyo = Application.Match(c, .Range("C:C"), 0)
        Set ten = .Cells(gyo, 5)
        '点数のコピー
        myten1 = ten.Offset(0, 0).Resize(1, 5).Value 'はじめの5つ
        myten2 = ten.Offset(0, 5).Resize(1, 5).Value '次の5つ
        '人事評価シートへ
        With Worksheets("人事評価シート")
          .Cells(13, 8).Resize(5, 1).Value = Application.Transpose(myten1)
          .Cells(19, 8).Resize(5, 1).Value = Application.Transpose(myten2)
        End With
      End With

    'プリントアウト
    Worksheets("人事評価シート").PrintOut
    
    Next
    'オートフィルターの解除
    .Range("A6", .Range("A65536").End(xlUp)).AutoFilter
  End With
0 hits

【28969】ワークシート間の検索集計 toki 05/9/19(月) 23:13 質問
【28972】Re:ワークシート間の検索集計 Statis 05/9/20(火) 9:09 回答
【28996】Re:ワークシート間の検索集計 toki 05/9/20(火) 21:45 お礼
【28995】Re:ワークシート間の検索集計 ponpon 05/9/20(火) 19:25 発言
【28997】Re:ワークシート間の検索集計 toki 05/9/20(火) 21:46 質問
【29000】Re:ワークシート間の検索集計 ponpon 05/9/20(火) 22:52 発言
【29002】Re:ワークシート間の検索集計 toki 05/9/21(水) 7:19 お礼
【29035】Re:ワークシート間の検索集計 ponpon 05/9/22(木) 2:46 発言
【29052】Re:ワークシート間の検索集計 toki 05/9/22(木) 15:21 お礼
【29086】Re:ワークシート間の検索集計 toki 05/9/23(金) 16:56 お礼
【29091】Re:ワークシート間の検索集計 ponpon 05/9/23(金) 21:05 発言
【29096】Re:ワークシート間の検索集計 toki 05/9/23(金) 22:03 質問
【29097】Re:ワークシート間の検索集計 ponpon 05/9/24(土) 0:23 発言
【29099】Re:ワークシート間の検索集計 toki 05/9/24(土) 12:46 お礼
【29104】Re:ワークシート間の検索集計 ponpon 05/9/24(土) 21:40 発言
【29106】Re:ワークシート間の検索集計 toki 05/9/24(土) 23:14 お礼
【29108】Re:ワークシート間の検索集計 ponpon 05/9/25(日) 5:49 発言
【29109】Re:ワークシート間の検索集計 toki 05/9/25(日) 8:27 お礼
【29122】Re:ワークシート間の検索集計 ponpon 05/9/25(日) 16:50 発言
【29126】Re:ワークシート間の検索集計 toki 05/9/25(日) 19:45 質問
【29128】Re:ワークシート間の検索集計 ponpon 05/9/25(日) 21:41 発言
【29188】Re:ワークシート間の検索集計 toki 05/9/27(火) 12:01 質問
【29199】Re:ワークシート間の検索集計 toki 05/9/27(火) 14:21 お礼
【29437】Re:ワークシート間の検索集計 toki 05/10/4(火) 23:08 質問
【29448】Re:ワークシート間の検索集計 Jaka 05/10/5(水) 13:16 発言
【29454】Re:ワークシート間の検索集計 ponpon 05/10/5(水) 18:34 発言
【29463】Re:ワークシート間の検索集計 toki 05/10/5(水) 22:21 質問
【29467】Re:ワークシート間の検索集計 ponpon 05/10/5(水) 22:55 発言
【29526】Re:ワークシート間の検索集計 toki 05/10/6(木) 21:57 お礼
【29529】Re:ワークシート間の検索集計 ponpon 05/10/6(木) 23:34 発言
【29461】Re:ワークシート間の検索集計 toki 05/10/5(水) 22:08 質問
【29462】Re:ワークシート間の検索集計 toki 05/10/5(水) 22:12 発言

52464 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free