Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 8 : Excel 2013)
先人の作成したマクロの集計方法を変更したいです。
投稿日時: 18/01/09 13:17:46
投稿者: 二葉

知恵袋で質問をあげていましたが解答をいただくことができませんでしたので
削除しこちらに質問させていただきます。
 
既存マクロの集計方法を変更したいです。
先人が作成した集計マクロがあります。
 
現在、集計方法として「#」を集計するマクロが組まれています。
 
この集計方法を変更して、
"8HHHH8" の場合のみ「#」の件数を集計し、他の場合は「#」の件数を集計を行わないように
変更したいです。
 
自分が行ったのは、まず、#を集計しないようにしようと考え、コードを追加しました。
その後、"8HHHH8" の場合のみ集計を行うコードを追加しようと考えていましたが結果がおかしくなります。
 
If wsh.Cells(ir, sum_c(j)) <> "" Or wsh.Cells(ir, sum_c(j)) <> "#" Then '■■■■■
「 Or wsh.Cells(ir, sum_c(j)) <> "#"」を追加したのですが上手く集計が行えません。
 
どうかよろしくお願いいたします。
 
□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□
 
Sub proc_Scount()
Dim ssum() As Integer
Dim sum_c() As Integer
 
Set tsh = ThisWorkbook.Sheets(1)
 
For i = 4 To 15
Set wxls = Workbooks.Open(Filename:=ThisWorkbook.Path & "\元データ\" & Cells(i, 13))
Set wsh = wxls.Sheets(1)
 
endr = wsh.Range("A" & Rows.Count).End(xlUp).Row
endc = wsh.Cells(1, Columns.Count).End(xlToLeft).Column
 
ReDim ssum(1 To 9)
ReDim sum_c(1 To 9)
 
For ic = 1 To endc
If wsh.Cells(1, ic) = "4DDDD4" Then
ord_c = ic
ElseIf wsh.Cells(1, ic) = "5EEEE5" Then
pj_c = ic
ElseIf wsh.Cells(1, ic) = "6FFFF6" Then
sum_c(1) = ic
ElseIf wsh.Cells(1, ic) = "7GGGG7" Then
sum_c(2) = ic
ElseIf wsh.Cells(1, ic) = "8HHHH8" Then ' ← ★★★この項目の場合のみ「#」の件数を集計したいです
sum_c(3) = ic
cymd1 = DateSerial(Year(tsh.Range("C" & i)), Month(tsh.Range("C" & i)) + 2, 1) - 1
sum_c(9) = ic
cymd2 = DateSerial(Year(tsh.Range("C" & i)), Month(tsh.Range("C" & i)) + 3, 1) - 1
End If
Next ic
 
For ir = 2 To endr
If wsh.Cells(ir, ord_c) = "実行中" Or wsh.Cells(ir, ord_c) = "終了" Then
 
flg = False
 
If i >= 10 And i <= 12 Then
If wsh.Cells(ir, pj_c) Like "4OOOO4" Then
flg = True
End If
ElseIf i >= 13 And i <= 15 Then
If wsh.Cells(ir, pj_c) = "5PPPP5" Then
flg = True
End If
Else
flg = True
End If
 
If flg Then
For j = 1 To 7
If wsh.Cells(ir, sum_c(j)) <> "" Or wsh.Cells(ir, sum_c(j)) <> "#" Then '■■■■■
ssum(j) = ssum(j) + 1
End If
Next j
If wsh.Cells(ir, sum_c(8)) <= cymd1 Then
ssum(8) = ssum(8) + 1
End If
If wsh.Cells(ir, sum_c(9)) <= cymd2 Then
ssum(9) = ssum(9) + 1
End If
End If
End If
Next ir
 
wxls.Close savechanges:=False
Set wxls = Nothing
Set wsh = Nothing
 
For j = 1 To 9
Cells(i, j + 3) = ssum(j)
Next j
Next i
End Sub

投稿日時: 18/01/09 14:00:31
投稿者: 二葉

>If wsh.Cells(ir, sum_c(j)) <> "" Or wsh.Cells(ir, sum_c(j)) <> "#" Then '■■■■■
>「 Or wsh.Cells(ir, sum_c(j)) <> "#"」を追加したのですが上手く集計が行えません。
このマクロは作業月の2ヶ月前の件数を反映するようになっています。
今月作業月1月とすると、2017年11月、12月の集計結果が反映されているのですが、
上記のコードを追加して実行すると全ての項目が同じ件数(総件数)になってしまいます。

投稿日時: 18/01/09 14:10:18
投稿者: 二葉

>If wsh.Cells(ir, sum_c(j)) <> "" Or wsh.Cells(ir, sum_c(j)) <> "#" Then '■■■■■
>「 Or wsh.Cells(ir, sum_c(j)) <> "#"」を追加したのですが上手く集計が行えません。
このマクロは作業月の2ヶ月前の件数を反映するようになっています。
今月作業月1月とすると、2017年11月、12月の集計結果が反映されているのですが、
上記のコードを追加して実行すると全ての項目が同じ件数(総件数)になってしまいます。
実際に確定した日付が入っているので日付の件数を集計しているのですが。

回答
投稿日時: 18/01/09 14:24:25
投稿者: WinArrow
投稿者のウェブサイトに移動

Or
ではなくて
And
では?

回答
投稿日時: 18/01/09 14:33:49
投稿者: WinArrow
投稿者のウェブサイトに移動

インデントをキチンとつけましょう
 

For ic = 1 To endc
    If wsh.Cells(1, ic) = "4DDDD4" Then
        ord_c = ic
    ElseIf wsh.Cells(1, ic) = "5EEEE5" Then
        pj_c = ic
    ElseIf wsh.Cells(1, ic) = "6FFFF6" Then
        sum_c(1) = ic
    ElseIf wsh.Cells(1, ic) = "7GGGG7" Then
        sum_c(2) = ic
    ElseIf wsh.Cells(1, ic) = "8HHHH8" Then '
 
のように
どうですか?・・・可読性がよくなったと思いませんか?
 
更に可読性をよくするには
For ic = 1 To endc
    Select Case wsh.Cells(1, ic).Valie
        Case "4DDDD4"
            ord_c = ic
        Case "5EEEE5"
            pj_c = ic
        Case "6FFFF6"
            sum_c(1) = ic
        Case "7GGGG7"
            sum_c(2) = ic
        Case "8HHHH8"
のように、Select Case 文を使うとよいでしょう。
 
それから
セルの値を参照するときは、
.Value プロパティを小りゃうしないようにしましょう。
 
 
 

投稿日時: 18/01/09 14:48:14
投稿者: 二葉

WinArrow様
 
早速のご回答をありがとうございました。
 
Andで実行してみたところ、全て0になってしまいました。
 
優秀なSEさんが作成されたというマクロで、省略が多過ぎて自分には殆ど解読できていません。
また、優秀な先人が作成したブックでは動きますが、新しいブックにコードを全て貼り付けても
同じようには動かないんです。
 
自分はまだまだ勉強中なので後の方が改修できないようなマクロは組まないよう気をつけて
ツール作成していきます。
 

回答
投稿日時: 18/01/09 14:56:21
投稿者: もこな2

メモ帳でちょこちょこ回答案を作っていたら WinArrowさんがフォローされておられた・・・
まぁかぶりますけど、せっかくなので投稿します。
 
 
とりあえず、コードが読みづらいのでまずは整理からはじめてみませんか?
たとえば、↓のように、適宜コメントやインデントを加えてみては如何でしょうか。

Sub ちょっと整理()
'==変数の宣言とか
Dim ssum() As Integer  'Integer型の動的配列
Dim sum_c() As Integer  'Integer型の動的配列
Dim tsh As Worksheet 'オブジェクト型変数(Worksheet)【追加】
Dim ic As Long, ord_c As Long, pj_c As Long '整数型の変数【追加】
Dim cymd1 As Date, cymd2 As Date '日付型【追加】

 '==処理
Set tsh = ThisWorkbook.Sheets(1)

For i = 4 To 15
    Set wxls = Workbooks.Open(Filename:=ThisWorkbook.Path & "\元データ\" & Cells(i, 13))
    Set wsh = wxls.Sheets(1)

    endr = wsh.Range("A" & Rows.Count).End(xlUp).Row
    endc = wsh.Cells(1, Columns.Count).End(xlToLeft).Column

    ReDim ssum(1 To 9) '1次元配列として定義
    ReDim sum_c(1 To 9) '1次元配列として定義
    '▽▽-----------------------------------------------------------
    For ic = 1 To endc
        If wsh.Cells(1, ic) = "4DDDD4" Then
            ord_c = ic
        ElseIf wsh.Cells(1, ic) = "5EEEE5" Then
            pj_c = ic
        ElseIf wsh.Cells(1, ic) = "6FFFF6" Then
            sum_c(1) = ic
        ElseIf wsh.Cells(1, ic) = "7GGGG7" Then
            sum_c(2) = ic
        ElseIf wsh.Cells(1, ic) = "8HHHH8" Then ' ← ★★★この項目の場合のみ「#」の件数を集計したいです
            sum_c(3) = ic
            cymd1 = DateSerial(Year(tsh.Range("C" & i)), Month(tsh.Range("C" & i)) + 2, 1) - 1
            sum_c(9) = ic
            cymd2 = DateSerial(Year(tsh.Range("C" & i)), Month(tsh.Range("C" & i)) + 3, 1) - 1
        End If
    Next ic
    '△△-----------------------------------------------------------
    '▽▽-----------------------------------------------------------
    For ir = 2 To endr
        If wsh.Cells(ir, ord_c) = "実行中" Or wsh.Cells(ir, ord_c) = "終了" Then
            flg = False
            If i >= 10 And i <= 12 Then
                If wsh.Cells(ir, pj_c) Like "4OOOO4" Then
                    flg = True
                End If
            ElseIf i >= 13 And i <= 15 Then
                If wsh.Cells(ir, pj_c) = "5PPPP5" Then
                flg = True
            End If
        Else
            flg = True
        End If

        If flg Then
            For j = 1 To 7
                If wsh.Cells(ir, sum_c(j)) <> "" Or wsh.Cells(ir, sum_c(j)) <> "#" Then '■■■■■
                    ssum(j) = ssum(j) + 1
                End If
            Next j
            If wsh.Cells(ir, sum_c(8)) <= cymd1 Then
                ssum(8) = ssum(8) + 1
            End If
            If wsh.Cells(ir, sum_c(9)) <= cymd2 Then
                ssum(9) = ssum(9) + 1
            End If
        End If
    End If  '← どれに対するEnd Ifか不明・・・
    Next ir
     '△△-----------------------------------------------------------
wxls.Close savechanges:=False
'Set wxls = Nothing ←またセットするから、オブジェクト解放はループ外へ
'Set wsh = Nothing ←またセットするから、オブジェクト解放はループ外へ
    For j = 1 To 9
        Cells(i, j + 3) = ssum(j)
    Next j

Next i

End Sub

 
質問とは違いますけど、とりあえず気になったこととして、宣言をしていない変数が多用されています。
自分に自信がある場合は別にいいのですが、慣れないうちは宣言をするクセをつけておいたほうがいいです。
モジュールの一番最初に
Option Explicit
と打ち込んでおきましょう。
<参考>
http://officetanaka.net/excel/vba/variable/02.htm
 
また、「ssum」「sum_c」を動的配列として宣言しつつ、コード内で
ReDim ssum(1 To 9) '1次元配列として定義
ReDim sum_c(1 To 9) '1次元配列として定義
としてますので、動的配列で宣言する意味がなくなってます。要素数が決まっているなら静的配列として宣言すべきだとおもいます。
 
このほか、wsh.Cells(1, ic).Valueに対してElseIF で分岐させてますけど、個人的にはSelect Case で分岐させた方が見やすいような気がします。(好みでしょうけど。。。)
IFによる分岐とSelect Caseによる分岐の違いをわかりやすく説明しているブログを見つけたのでリンク置いておきます。
http://excel-master.net/macro-vba/excel-vba-if-select-case-proper-use/
 

投稿日時: 18/01/09 15:10:18
投稿者: 二葉

もこな2様
 
昨年はありがとうございました。本年もどうぞよろしくお願い致します。
 
皆様ご指摘くださるのを読むと、このコード、やはり読みにくいですよね。
変数宣言は必要なはずなのにされていないですし、それぞれで何の処理が行われているのか
解読できないんです。
 
もこな2様からいただいた教えを元に今からコードの整理をしてみます。
 
ありがとうございます。

投稿日時: 18/01/09 16:44:11
投稿者: 二葉

WinArrow様、もこな2様のご指導でマクロは吐き出されるシートを見ながら
インデントや動作説明を入れてみました。(まだまだ読みにくいかも知れません。すみません。)
 
お蔭さまで、自分でも随分分かり易くなってきましたが、やはり、××××××××××××××以下の
処理がよく理解できません。
 
すみませんがよろしくお願いします。
 
● ssum 、sum_c が@次元配列として定義されているのは理解できましたが、
  どのように関連しているのかがコードを読んでも理解できません。
 
● 配列コードはコメントアウトしている内容で大丈夫でしょうか。
 
● 根本的なとろこですが、集計はどのコードで行われているのでしょうか。
 
● 集計項目4だけを#も集計する場合は、分けてコードを書くべきでしょうか。
 
Option Explicit
 
Sub proc_shuukei()
 
    Dim tsh As Worksheet 'オブジェクト型変数(Worksheet)
    Dim ic As Long '整数型の変数
    Dim cymd1 As Date, cymd2 As Date '日付型
    Dim ord_c As Integer '抽出条件@の変数宣言
    Dim pj_c As Integer '抽出条件Aの変数宣言
   
     
'==処理
    Set tsh = ThisWorkbook.Sheets(1)
 
    For i = 4 To 15
        Set wxls = Workbooks.Open(Filename:=ThisWorkbook.Path & "\DT\" & Cells(i, 13))
        Set wsh = wxls.Sheets(1)
    Next i
     
        endr = wsh.Range("A" & Rows.Count).End(xlUp).Row
        endc = wsh.Cells(1, Columns.Count).End(xlToLeft).Column
         
        Dim ssum(1 To 9) '1次元配列として定義  集計項目1〜9のことか???
        Dim sum_c(1 To 7) '1次元配列として定義 集計項目1〜7
 
'▽▽---------------------------------------------------------------------------------------------------------▽▽
        
       For ic = 1 To endc
             Select Case wsh.Cells(1, ic).Valie
              
                    Case "抽出条件@" '抽出条件@
                         ord_c = ic
             
                    Case "抽出条件A"    '抽出条件A
                          pj_c = ic
                     
                    Case "集計項目1" '集計項目@
                         sum_c(1) = ic
                          
                    Case "集計項目2" '集計項目2
                         sum_c(2) = ic
 
                    Case "集計項目3" '集計項目3
                         sum_c(3) = ic
             
                    Case 集計項目4" '集計項目4
                         sum_c(4) = ic
                     
                    Case "集計項目5" '集計項目5
                         sum_c(5) = ic
                          
                    Case "集計項目6" '集計項目6
                         sum_c(6) = ic
 
                    Case "集計項目7" '集計項目7
                         sum_c(7) = ic
                          
                    Case "集計項目8" '集計項目8 1ヶ月後までの予定日件数
                         sum_c(8) = ic
 
               cymd1 = DateSerial(Year(tsh.Range("C" & i)), Month(tsh.Range("C" & i)) + 2, 1) - 1 '集計項目8 1ヶ月後までの予定日件数
               sum_c(9) = ic
               cymd2 = DateSerial(Year(tsh.Range("C" & i)), Month(tsh.Range("C" & i)) + 3, 1) - 1 '2ヶ月後までの予定日件数
             
        Next ic
         
'△△---------------------------------------------------------------------------------------------------------△△
'▽▽---------------------------------------------------------------------------------------------------------▽▽
 
        For ir = 2 To endr '抽出条件@が"途中"か"終了"の場合
            If wsh.Cells(ir, ord_c) = "途中" Or wsh.Cells(ir, ord_c) = "終了" Then
 
                flg = False
 
                If i >= 10 And i <= 12 Then '抽出条件Aが "KKYP*"の場合
                    If wsh.Cells(ir, pj_c) Like "KKYP*" Then
                        flg = True
                    End If
                     
                ElseIf i >= 13 And i <= 15 Then '抽出条件A "障害あり"の場合
                    If wsh.Cells(ir, pj_c) = "障害あり" Then
                        flg = True
                    End If
                     
                Else
                    flg = True
                End If
 
'××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××
'↓↓↓↓ここから下の処理について何が行われているのか分からないです。↓↓↓↓↓↓
 
                If flg Then
                  For j = 1 To 7 '集計項目1〜7を下の条件で集計する
'
' sum_c(0) = 1 '集計項目1〜7を配列に入れる
' Dim sum_c(6) As Long
' Dim i As Long
' For i = 1 To 7
' sum_c(i) = i
' Next i
'
                    If wsh.Cells(ir, sum_c(j)) <> "" Or wsh.Cells(ir, sum_c(j)) <> "#" Then ' ’ブランクと#以外を集計している、つもりです。
                            ssum(j) = ssum(j) + 1
                        End If
                  Next j
                     
                    If wsh.Cells(ir, sum_c(8)) <= cymd1 Then 
                        ssum(8) = ssum(8) + 1
                    End If
                    If wsh.Cells(ir, sum_c(9)) <= cymd2 Then
                        ssum(9) = ssum(9) + 1
                    End If
                End If
            End If
        Next ir
'△△---------------------------------------------------------------------------------------------------------△△
 
        wxls.Close savechanges:=False
' Set wxls = Nothing   ←またセットするから、オブジェクト解放はループ外へ
' Set wsh = Nothing    ←またセットするから、オブジェクト解放はループ外へ
 
        For j = 1 To 9
            Cells(i, j + 3) = ssum(j)
        Next j
 
End Sub

回答
投稿日時: 18/01/09 17:13:21
投稿者: WinArrow
投稿者のウェブサイトに移動

インデントをつけるのなら、インデントだけにしましょうよ!
 
余計なことして、結局、壊していることに気が付いていないらしい。
 
例えば、↓

引用:
For i = 4 To 15
         Set wxls = Workbooks.Open(Filename:=ThisWorkbook.Path & "\DT\" & Cells(i, 13))
         Set wsh = wxls.Sheets(1)
     Next i

 
Next i
は、不要
 
End Select
が無い。
 

投稿日時: 18/01/09 17:14:19
投稿者: 二葉

ありがとうございます。
修正します。

回答
投稿日時: 18/01/09 17:15:49
投稿者: もこな2

これまた、質問の回答ではないですが、複雑な処理をするものを作る(改修する)場合、思い切ってプロシージャをメイン処理(データのあるブックを開いて閉じる)とサブ処理(データのあるブックからコピーする)に分けてしまうのも手かと思います。
 

Sub メインルーチン()
'==変数の宣言とか
Dim 対象ブック As Workbook 'オブジェクト型変数(Workbook)
Dim 対象シート As Worksheet, Myシート As Worksheet 'オブジェクト型変数(Worksheet)
Dim i As Long '整数型の変数

 '==主処理
For i = 4 To 15
    Set 対象ブック = Workbooks.Open(Filename:=ThisWorkbook.Path & "\元データ\" & Cells(i, 13))
    Set 対象シート = 対象ブック.Sheets(1)

    Call サブルーチン(対象シート, i)

     対象ブック.Close savechanges:=False
Next i

'==後処理(オブジェクト解放)(省略可)
    Set 対象ブック = Nothing
    Set 対象シート = Nothing

End Sub

Sub サブルーチン(対象シート As Worksheet, i As Long)
'==変数の宣言とか
    Dim ssum(1 To 9) As Integer  'Integer型の静的配列
    Dim sum_c(1 To 9) As Integer  'Integer型の静的配列
    Dim Myシート As Worksheet 'オブジェクト型変数(Worksheet)
        Set Myシート = ThisWorkbook.Sheets(1)
    Dim 最終行 As Long, 最終列 As Long '整数型の変数
    Dim ic As Long, ord_c As Long, pj_c As Long '整数型の変数
    Dim cymd1 As Date, cymd2 As Date '日付型の変数
    Dim flg As Boolean 'ふらぐ

 '==主処理
    最終行 = 対象シート.Range("A" & Rows.Count).End(xlUp).Row
    最終列 = 対象シート.Cells(1, Columns.Count).End(xlToLeft).Column

     '▽▽-----------------------------------------------------------
    For ic = 1 To 最終列
        '慣れないうちはプロパティまで記述した方がいいとおもいます(以下同じ)
        '                                   ↓
        Select Case 対象シート.Cells(1, ic).Value
            Case Is = "4DDDD4"
                ord_c = ic
            Case Is = "5EEEE5"
                pj_c = ic
            Case Is = "6FFFF6"
                sum_c(1) = ic
            Case Is = "7GGGG7"
                sum_c(2) = ic
                Case Is = "8HHHH8"
                With Myシート.Range("C" & i)
                    sum_c(3) = ic
                    cymd1 = DateSerial(Year(.Value), Month(.Value) + 2, 1) - 1 '来月末
                    sum_c(9) = ic
                    cymd2 = DateSerial(Year(.Value), Month(.Value) + 3, 1) - 1 '再来月末
                End With
            Case Else
                'なにもなし
        End Select
    Next ic
     '△△-----------------------------------------------------------
     '▽▽-----------------------------------------------------------
    For ir = 2 To 最終行 '1行目から最終行まで
        If ord_c = 0 Then Stop '【「ord_c」が取得されていない場合停止させる】
        If 対象シート.Cells(ir, ord_c).Value = "実行中" Or 対象シート.Cells(ir, ord_c).Value = "終了" Then
            flg = False
            If pj_c = 0 Then Stop '【「pj_c」が取得されていない場合停止させる】
            Select Case True
                Case i >= 10 And i <= 12
                    If 対象シート.Cells(ir, pj_c) Like "4OOOO4" Then flg = True
                Case i >= 13 And i <= 15
                    If 対象シート.Cells(ir, pj_c) = "5PPPP5" Then flg = True
                Case Else '「i」が10〜12、13〜15以外はなにも処理しない
                    'なにもなし
            End Select
        Else
            flg = True
        End If

        If flg = True Then '「= True」を明示した方が読みやすい(と個人的には思います)
            For j = 1 To 7
                With 対象シート.Cells(ir, sum_c(j))
                    If .Value <> "" Or .Value <> "#" Then ssum(j) = ssum(j) + 1
                End With
            Next j
            If 対象シート.Cells(ir, sum_c(8)).Value <= cymd1 Then ssum(8) = ssum(8) + 1
            If 対象シート.Cells(ir, sum_c(9)).Value <= cymd2 Then ssum(9) = ssum(9) + 1
        End If
    End If  '← どれに対するEnd Ifか不明・・・
    Next ir
     '△△-----------------------------------------------------------

    '1次元配列を連続するセル範囲に入れるならループしなくてもよい(とおもう)
    With Myシート
        .Range(.Cells(i, 4), .Cells(i, 12)).Value = ssum
    End With

End Sub

投稿日時: 18/01/09 17:20:24
投稿者: 二葉

>複雑な処理をするものを作る(改修する)場合、思い切ってプロシージャをメイン処理(データのあるブック>を開いて閉じる)とサブ処理(データのあるブックからコピーする)に分けてしまうのも手かと思います。
 
もこな2様
 
ありがとうございます。
ネットで読んで教えてくださった方法があるのは知っていますが、まだ使ったことがありません。
勉強してみます。
 

回答
投稿日時: 18/01/09 17:26:25
投稿者: もこな2

引用:
ssum 、sum_c が1次元配列として定義されているのは理解できましたが、どのように関連しているのかがコードを読んでも理解できません。
質問者さんがわからないと回答者もわからないとおもいます。
強いて言えば、前にコードを作成された方が配列が好きだったんじゃないでしょうか
↓であれば、意味はあるとおもいますが・・・
    '1次元配列を連続するセル範囲に入れるならループしなくてもよい(とおもう)
    With Myシート
        .Range(.Cells(i, 4), .Cells(i, 12)).Value = ssum
    End With

 
ちょっと気になった点としてですけど
引用:
既存マクロの集計方法を変更したいです。
先人が作成した集計マクロがあります。
  
現在、集計方法として「#」を集計するマクロが組まれています。
  
この集計方法を変更して、
"8HHHH8" の場合のみ「#」の件数を集計し、他の場合は「#」の件数を集計を行わないように
変更したいです。
とのことですが、そもそも”集計”するマクロじゃないように思います。
データが入ってるブックから条件に基づいて自ブックのシートへコピーしているだけなので、”集積”ではないかと・・・

投稿日時: 18/01/09 17:55:16
投稿者: 二葉

もこな2様
 
昨年12月に改修を依頼されずっと考えいたんですが、もこな2様からご教示いただいたコードで
一瞬で結果がでました。
本当にすごいです。
今回も助けられました、ありがとうございます。
 
先人のマクロはコメントや変数の宣言を加えていく、今回も大変勉強になりました。
 
>質問者さんがわからないと回答者もわからないとおもいます。
そうですよね。すみません。もっとしかっり勉強しないといけないです。
 
>そもそも”集計”するマクロじゃないように思います。
>データが入ってるブックから条件に基づいて自ブックのシートへコピーしているだけなので、
>”集積”ではないかと・・・
集計ではなかったんですね。
そんなことが分からない自分が恥ずかしいです。
本当にいつもありがとうございます。
本当にすごいスキルです。
 
 
皆さん始めたころは自分と同じだったと思いますが何から勉強すればみなさんのようになれますか。

回答
投稿日時: 18/01/09 17:57:14
投稿者: WinArrow
投稿者のウェブサイトに移動

※"#"を集計したい・・・
言葉だけではなく、どこにどのようなタイミングで・・・など明確にしないと、なんとも言い難い。
 
元のコードを読みやすく整理したので、アップします。
未定義変数は、勝手に定義しましたが、あっているかわからないので
実行してみて修正してください。
「Or」を「And」に変更しておきました。
最後のステップでセルに格納しているが、どこのシートなの?
 
 
元のコードを理解しないまま、安易に修正/変更すると壊してしまいます。
ステップ実行で、元のコードを理解するところから始めましょう。
改造はそれからです。
 
 
Option Explicit
 
Sub proc_Scount()
Dim ssum(1 To 9) As Long
Dim sum_c(1 To 9) As Long
Dim tsh As Worksheet
Dim i As Long, ir As Long, j As Long
Dim wxls As Workbook, wsh As Worksheet
Dim endr As Long, endc As Long, ic As Long
Dim ord_c As Long, pj_c As Long
Dim cymd1 As Date, cymd2 As Date
Dim flg As Boolean
 
 
 
    Set tsh = ThisWorkbook.Sheets(1)
   
    For i = 4 To 15
        Set wxls = Workbooks.Open(Filename:=ThisWorkbook.Path & "\元データ\" & Cells(i, 13))
        Set wsh = wxls.Sheets(1)
   
        endr = wsh.Range("A" & wsh.Rows.Count).End(xlUp).Row
        endc = wsh.Cells(1, wsh.Columns.Count).End(xlToLeft).Column
   
        Erase sum_c
        Erase ssum
         
        For ic = 1 To endc
            Select Case wsh.Cells(1, ic).Value
                Case "4DDDD4"
                    ord_c = ic
                Case "5EEEE5"
                    pj_c = ic
                Case "6FFFF6"
                    sum_c(1) = ic
                Case "7GGGG7"
                    sum_c(2) = ic
                Case "8HHHH8" ' ← ★★★この項目の場合のみ「#」の件数を集計したいです
                    sum_c(3) = ic
                    cymd1 = DateSerial(Year(tsh.Range("C" & i).Value), Month(tsh.Range("C" & i).Value) + 2, 1) - 1
                    sum_c(9) = ic
                    cymd2 = DateSerial(Year(tsh.Range("C" & i).Value), Month(tsh.Range("C" & i).Value) + 3, 1) - 1
            End Select
        Next ic
   
        For ir = 2 To endr
            If wsh.Cells(ir, ord_c).Value = "実行中" Or wsh.Cells(ir, ord_c).Value = "終了" Then
                flg = False
   
                If i >= 10 And i <= 12 Then
                    If wsh.Cells(ir, pj_c).Value Like "4OOOO4" Then
                        flg = True
                    End If
                ElseIf i >= 13 And i <= 15 Then
                    If wsh.Cells(ir, pj_c).Value = "5PPPP5" Then
                        flg = True
                    End If
                Else
                    flg = True
                End If
   
                If flg Then
                    For j = 1 To 7
                        If wsh.Cells(ir, sum_c(j)).Value <> "" And wsh.Cells(ir, sum_c(j)).Value <> "#" Then '■■■■■
                            ssum(j) = ssum(j) + 1
                        End If
                    Next j
                    If wsh.Cells(ir, sum_c(8)).Value <= cymd1 Then
                        ssum(8) = ssum(8) + 1
                    End If
                    If wsh.Cells(ir, sum_c(9)).Value <= cymd2 Then
                        ssum(9) = ssum(9) + 1
                    End If
                End If
            End If
        Next ir
   
        wxls.Close savechanges:=False
        Set wxls = Nothing
        Set wsh = Nothing
   
        For j = 1 To 9
            Cells(i, j + 3).Value = ssum(j) 'どのシートのセルなんでしょう?
        Next j
    Next i
 
End Sub

回答
投稿日時: 18/01/09 18:33:32
投稿者: WinArrow
投稿者のウェブサイトに移動

コードを整理している間に
ずいぶんと話が進んでいましたね・・・・
 
↑は、戻ってしまうので、スキップしていただいても結構です。
 

回答
投稿日時: 18/01/10 02:52:36
投稿者: もこな2

引用順がめちゃくちゃですが、気になったところからコメントしているのでご容赦を。
 

引用:
昨年12月に改修を依頼されずっと考えいたんですが、もこな2様からご教示いただいたコードで
一瞬で結果がでました。
本当にすごいです。
今回も助けられました、ありがとうございます。
どれのことでしょう・・・
今回はまだ何もアドバイスしてないような・・・・
 
引用:
>質問者さんがわからないと回答者もわからないとおもいます。
そうですよね。すみません。もっとしかっり勉強しないといけないです。
すみません。言葉が足りないというか適切ではありませんでした。
回答者が作ったコードではないので推測することくらいしかできません。実際のところは作った本人に直接聞く以外はないんじゃないかと思います。
 
引用:
配列コードはコメントアウトしている内容で大丈夫でしょうか。
どの部分かわかりません。抜き出すか、太字にするか、色を変えるか・・・なんにせよ掲示板上で分かるようにしていただいたほうが答えやすいです。
そもそも「配列コード」とはなにか。何を聞きたいのかが私には掴めてないです。
 
引用:
集計項目4だけを#も集計する場合は、分けてコードを書くべきでしょうか。
これも何を聞きたいのか私にはつかめてないです。
 
引用:
>If wsh.Cells(ir, sum_c(j)) <> "" Or wsh.Cells(ir, sum_c(j)) <> "#" Then '■■■■■
>「 Or wsh.Cells(ir, sum_c(j)) <> "#"」を追加したのですが上手く集計が行えません。
このマクロは作業月の2ヶ月前の件数を反映するようになっています。
今月作業月1月とすると、2017年11月、12月の集計結果が反映されているのですが、
上記のコードを追加して実行すると全ての項目が同じ件数(総件数)になってしまいます。
実際に確定した日付が入っているので日付の件数を集計しているのですが。
コードの、どの部分を追加して、どの部分が元からあったのかわからないので、色分けするなり何とか掲示板上で分かるように表現していただいたほうが状況がつかめるかとおもいます。
 
とりあえず、WinArrowさんの指摘のとおり or ではなく And に修正すべきだとは思います。
orだと、wsh.Cells(ir, sum_c(j)).Valueがブランク以外 または、「#」以外になるので、すべて条件に合致してしまいます。
ブランクでも「#」以外だから条件に合致、「#」でもブランク以外だから条件に合致。
(私の投稿したコードは、WinArrowさんの指摘を拝見するまで、気づかなかったので直ってないです)
For j = 1 To 7
  With 対象シート.Cells(ir, sum_c(j))
    If .Value <> "" And .Value <> "#" Then ssum(j) = ssum(j) + 1
  End With
Next j
 
 
もう一か所、私が投稿したコードにミスがありました。
メインルーチンの
Myシート As Worksheet
 ↑ 見てわかるとおりこれ要らないです。(メインルーチン側でMyシートに書き込まないので)
 
 
引用:
先人のマクロはコメントや変数の宣言を加えていく、今回も大変勉強になりました。
なんか違うような。。。
とりあえず、変数は別に省略してもいいんですよ。エクセルVBAの仕様上は。
ただ、↓のサイトにわかりやすく解説されていますが、自分が大変になるだけなので、私は変数の宣言を省略することはお勧めしません。
http://officetanaka.net/excel/vba/beginner/06.htm
コメントやインデントも、自分で分かってればいいんですけど、ループの入れ子などを複雑なものになっていけばなっていくほど、大抵はわけがわからなくなるので、できれば付けたほうがいいとおもうだけです。先人のマクロうんぬんとは関係がありません。
繰り返しになりますが、自分にものすごい自信があって、自分以外がそのコードを改修することがなければ独自路線で進んでも構わないと思います。
 
引用:
Cells(i, j + 3) = ssum(j)
WinArrowさんも指摘されていますが、これは、前回説明のとおり
ActiveSheet.Cells(i, j + 3) = ssum(j)って理解されます。
そりゃ、データが入ってるブックを閉じたら、元アクティブだった自ブックのアクティブだったシートに戻ってくるんでしょうけど、確実ではありませんから、対象オブジェクトを省略せず、どのブックのどのシートのcellsなのか、きちんと記述すべきです。
 
引用:
Select Case wsh.Cells(1, ic).Valie
    Case "抽出条件@" '抽出条件@
   ord_c = ic
これ、VBエディタで編集してないですよね?
すくなくとも、Caseのあと必要なものが抜けてますし(VBEで書いてたら記述時点でエラーになるはず)、セルに"抽出条件@"って書いてあるんでしょうか?
IF文を置き換えてるわけですから、WinArrowさんのでも私のでもよいのでマネしてみてください。
 
 
とりあえず、この辺が気になりましたので乱文ながらコメントいたします。

回答
投稿日時: 18/01/10 14:50:10
投稿者: WinArrow
投稿者のウェブサイトに移動

疑問点1
 
> Case "8HHHH8" ' ← ★★★この項目の場合のみ「#」の件数を集計したいです
 と
> If wsh.Cells(ir, sum_c(j)) <> "" And wsh.Cells(ir, sum_c(j)) <> "#" Then
とは、どのような関係なのかな?
 
上のコードで
>sum_c(3) = ic
 
3番目に入れているんだから、下の処理でループする必要はないと思うが・・・・・
 
 

回答
投稿日時: 18/01/12 10:22:44
投稿者: mattuwan44

遅ればせながら、横入りすみません。
 
たぶん、訳が分からないコードを改変するよりは、
新たに作り直した方が良いと思います。
 
やりたいことは、
「1行目に8HHHH8と入っている列の内、文頭に#が入っているデータを表から行削除したい。」
と読みましたが違いますでしょうか?
 
違うなら、やりたいことを説明してください。
その説明がプログラムになっていきます。
 
Sub test()
    Dim rngTable As Range '表のセル範囲
    Dim ixCol As Variant '検索対象の列番号
     
    '操作対象の表のセル範囲
    Set rngTable = ActiveSheet.Range("a1").CurrentRegion
     
    'キーワードを抽出する列の検索
    ixCol = Application.Match("8HHHH8", rngTable.Rows(1), 0)
     
     
    '不要なデータを削除
    With rngTable
        .AutoFilter Field:=ixCol, Criteria1:="=#*"
        .Offset(1).Delete Shift:=xlShiftUp
        .AutoFilter
    End With
End Sub
 
上記はエクセルの「オートフィルター」という機能を使って、
特定のデータを除外する例です。
データはシート上に展開されているのですから、
エクセルの機能で出来ることはエクセルに任せると気が楽です。

回答
投稿日時: 18/01/12 10:26:47
投稿者: mattuwan44

エラー回避をわすれてました^^;
 
Sub test()
    Dim rngTable As Range '表のセル範囲
    Dim ixCol As Variant '検索対象の列番号
 
    '操作対象の表のセル範囲
    Set rngTable = ActiveSheet.Range("a1").CurrentRegion
 
    'キーワードを抽出する列の検索
    ixCol = Application.Match("8HHHH8", rngTable.Rows(1), 0)
 
'列が見つかったら(見つかったら数値、見つからなかったらエラー値)
    If IsNumeric(ixCol) = True Then

        '不要なデータを削除
        With rngTable
            .AutoFilter Field:=ixCol, Criteria1:="=#*"
            .Offset(1).Delete Shift:=xlShiftUp
            .AutoFilter
        End With
    End If
End Sub

投稿日時: 18/01/12 17:43:12
投稿者: 二葉

まずはお礼が遅くなったお詫びとお礼をさせてください。
 
お礼が遅くなり、大変申し訳ございません。
すみませんでした。
 
本当に丁寧に教えてくださいましてありがとうございます。
じっくり読んで理解します。
 
ありがとうございます。
 
もこな2様
先日教えていただいたコード、事前にWinArrow様よりorではなくAndでは?とご指摘を頂いていたのでAndにしています。
  
やりたいことは
条件抽出した件数をカウントし、決まった表にその件数を入れること、なのですが既存のコードを見て
直せたつもりが直っておらず、困っていました。
 
質問をさせていただくのにも経験や知識が必要ですね。
つたない質問を読んでくださいまして、ありがとうございます。
m(_ _)m
 

投稿日時: 18/01/13 08:40:56
投稿者: 二葉

おはようございます。
 
本当に助かりました。
ありがとうございました。
 
気が遠くなるくらいまだまだですが出来ないなりに楽しいので
皆様のようにできるようになってもっと楽しめるよう努めます。
 
 
ありがとうございます。