Excel (VBA)

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

 
(Windows 7全般 : Excel 2010)
連続する列にそれぞれ別の計算結果を表示させるには
投稿日時: 17/03/13 22:40:36
投稿者: iori_y

教えてください。
 
売上一覧のデータがあります。
いつもは1万件以下位なのですが、時々1万5千前後くらいの件数になり、数式その他を割り当てて集計していると、かなり時間がかかります。
そこで、計算式をマクロで組んで一気に結果表示したいと思っています。
 
試行錯誤の結果、以下の式で一気に表示が可能になりました。

 
Dim myRng() As Variant

   myRng = Range(.Cells(2, 24), .Cells(lastR(0) + 1, 24))
'支店判定
    For i = 2 To lastR(0)
        myRng(i, 1) = Application.VLookup(WS(2).Cells(i, 3), WS(6).Range("I2:J" & lastR(3)), 2, False) 
    Next i
        Range(.Cells(1, 24), .Cells(lastR(0), 24)) = myRng

 
全て一括で処理をするのではなく、今まで使用している表のレイアウトを崩さないで作るというのが条件にありますので、このほかにも「部門判定」「支店+部門名」・・・といった数式が以下の表のとおり6列分あります。
	 W	   X	Y	   Z	  AA	 AB
1	担当営業  支店	部門	支店+部門	集計対象か否か	対象品番
2						

 
そこで教えていただきたいのは、
 1)myRngは毎回列ごとに設定したほうが良いのでしょうか?
   (上の式は24列目ですが、隣の列の数式の場合は25列目で作る)
 2)myRng(i,1)の( )の中は、「(範囲の中の)i行目の1列目」を指していると言うことなのでしょうか?
   (すみません、ここは”このように入れたら動いた”だったので、この理解でいいのか不安なのです)
 3)上の例は「連続する列」に「それぞれ別の数式を入れていく」ですが、決まった範囲の中で1列ごとに式を設定するにはどのようにしたら良いのでしょうか?
  (例えば、下の表)
7月		8月		9月	・・・
計画	実績	計画	実績	計画	実績  ・・・

 
配列はまだ理解仕切れて居ないので、そもそも上の式も間違っているかもしれません。
 
御手数をおかけしますが、よろしくお願いします。

回答
投稿日時: 17/03/13 23:19:44
投稿者: mattuwan44

>数式その他を割り当てて集計していると、かなり時間がかかります。
>そこで、計算式をマクロで組んで一気に結果表示したいと思っています。

再計算を手動にしたらダメですかね?
 
マクロだから速くなるってのは無さそうです。
(計算がメインのソフトですもん)

回答
投稿日時: 17/03/13 23:40:53
投稿者: sy

こんばんわ。

iori_y さんの引用:
時々1万5千前後くらいの件数になり、数式その他を割り当てて集計していると、かなり時間がかかります。
そこで、計算式をマクロで組んで一気に結果表示したいと思っています。
 
試行錯誤の結果、以下の式で一気に表示が可能になりました。
 Dim myRng As Range

   myRng = Range(.Cells(2, 24), .Cells(lastR(0) + 1, 24))
'支店判定
    For i = 2 To lastR(0)
        myRng(i, 1) = Application.VLookup(WS(2).Cells(i, 3), WS(6).Range("I2:J" & lastR(3)), 2, False) 
    Next i
        Range(.Cells(1, 24), .Cells(lastR(0), 24)) = myRng


これって遅くないですか?
単にVBA上で計算して結果を1セルづつ代入してるので、計算効率としては最悪のコードになっています。
WS(2)やWS(6)のシート名が分かりませんが、仮にSheet2、Sheet6だとして以下のようにした方が早いと思います。
    Dim myRng As Range

    Set myRng = Range(Cells(2, 24), Cells(lastR(0) + 1, 24))
    myRng.Formula = "=VLOOKUP(Sheet2!C2,Sheet6!I$2:J$" & lastR(3) & ",2,FALSE)"
    myRng.Value = myRng.Value

これでも遅いようなら計算式そのものを見直すか、連想配列などを使うかですね。
 
何れにしても全てのシートのレイアウトが分からないと、皆さんまともに回答は出来ませんので
まずは全てのシートのレイアウトを提示して下さい。

回答
投稿日時: 17/03/14 10:01:25
投稿者: mattuwan44

Sub test()
    Dim rngTable As Range
    Dim rngCol As Range
    Dim c As Range
    Dim strFormula As String
 
    '表のセル範囲を取得
    Set rngTable = ActiveSheet.Range("A1").CurrentRegion
 
    '列毎の繰り返し
    For Each c In rngTable.Columns
        Select Case c(2).Value
            Case "集計対象か否か"
                strFormula = "=Vlookup(D3,データ,2,0)"
            Case "実績"
                strFormula = "=Vlookup(D3,データ,5,0)"
        End Select
 
        Application.Range(c(3), c(c.Count)).Formula = strFormula
    Next
     
    '値に変換
    'rngTable.Value = rngTable.Value
End Sub
 
列毎に処理する例
2行目の項目名で条件分岐して数式を設定し
列毎に式を挿入します。
数式を入れるたびに再計算が行われると重いので、
マクロで、再計算を自動でしないように設定を変えるといいと思います。
(その処理は書いてません。検索して解らなければ聞いて下さい)
この辺を叩き台に書いてみてください

投稿日時: 17/03/14 22:25:37
投稿者: iori_y

syさん
 

引用:
これって遅くないですか?

これでも最初に作ったコードは4分掛かっていまして・・・。
時間が掛かっている原因が1個ずつセルにアクセス(書き込み)しているからという理由が判り、色々たどり着いて質問に載せたコードになりました。
myRng(i,1)でもセルにアクセスするんじゃないのかな?と思いつつ、それでも30秒位までにスピードは上がったので、あとはmyRngの設定の仕方とかで変わるのかな・・・?と勝手に思っていた次第です。
 
教えていただいたコードを使い、
 
   Dim myRng As Range

    Set myRng = Range(Cells(2, 24), Cells(lastR(0) + 1, 24))
    myRng.Formula = "=VLOOKUP(Sheet2!C2,Sheet6!I$2:J$" & lastR(3) & ",2,FALSE)"
    myRng.Value = myRng.Value

  Set myRng = Nothing

    Set myRng = Range(Cells(2, 25), Cells(lastR(0) + 1, 25))
    myRng.Formula = "=VLOOKUP(Sheet2!C2,Sheet6!I$2:J$" & lastR(3) & ",3,FALSE)"
    myRng.Value = myRng.Value

    Set myRng = nothing     

試しにこんな感じで6列分設定してみました。
 
これでも遅いようなら計算式そのものを見直すか、連想配列などを使うかですね。

 
実行してみると嬉しくなるくらい早くなりました。
ほかにやりたいことを入れても3秒で表示されて、今までの10分の1になりました。
 
 
実際は「対象か否か」と「対象品番」はIF文で条件分岐させるユーザー関数を作ったのですが、それを使うと遅くなっていることも判りましたので、ワークシートで使っていたIF関数の式を使おうと思います。
 
 
mattuwan44 さん
 
引用:
再計算を手動にしたらダメですかね?

シートがアクティブになったら/シート上に配置されたボタンをおしたら 自動→手動というのもありかも、と考えました。
ネットで探すといくつか見つけたので、それも試してみようと思います。
 
ただ、自分の理解を深めるためにも教えてください。
 
mattuwan44 さんが提示してくれたコードを試したところ、
Sub test() 
     Dim rngTable As Range 
     Dim rngCol As Range 
     Dim c As Range 
     Dim strFormula As String 
  
     '表のセル範囲を取得 
    Set rngTable = ActiveSheet.Range("A1").CurrentRegion 
  
     '列毎の繰り返し 
    For Each c In rngTable.Columns 
         Select Case c(1).Value 
             Case "集計対象か否か"   ’←★★
                 strFormula = "=Vlookup(D3,データ,2,0)" 
             Case "実績" 
                 strFormula = "=Vlookup(D3,データ,5,0)" 
         End Select 
  
         Application.Range(c(2), c(c.Count)).Formula = strFormula 
     Next 
      
     '値に変換 
    'rngTable.Value = rngTable.Value 
 End Sub 

 
「型が違います」エラーが発生し、★★のところが黄色くなってしまいました。
※頂いた説明から、使用している表の見出しは1行目なのでc(1)、c(2)に変えています。
ここに書き込みながら疑問が出てきましたが、rngTable.Columns だとcには「列」を格納していることになりますか?
c(1)だと、もしかして「1行目」ではなく「1列目」をさしてしまうのでしょうか??
 
 
今日あまり触れなかったので、明日もう一度チャレンジしようと思います。

回答
投稿日時: 17/03/14 22:50:59
投稿者: WinArrow
投稿者のウェブサイトに移動

>c(1)だと、もしかして「1行目」ではなく「1列目」をさしてしまうのでしょうか??
 
そうです。
 
>rngTable.Columns
という指定だからです。

回答
投稿日時: 17/03/14 23:12:35
投稿者: sy

iori_y さんの引用:
   Dim myRng As Range

    Set myRng = Range(Cells(2, 24), Cells(lastR(0) + 1, 24))
    myRng.Formula = "=VLOOKUP(Sheet2!C2,Sheet6!I$2:J$" & lastR(3) & ",2,FALSE)"
    myRng.Value = myRng.Value

  Set myRng = Nothing

    Set myRng = Range(Cells(2, 25), Cells(lastR(0) + 1, 25))
    myRng.Formula = "=VLOOKUP(Sheet2!C2,Sheet6!I$2:J$" & lastR(3) & ",3,FALSE)"
    myRng.Value = myRng.Value

    Set myRng = nothing

Set myRng = Nothing ですけど、これは一番最後に1回すれば良いですよ。
 
若しくはあまり薦めてはいけないのかもですけど、myRngがこのプロシージャ内で宣言されているなら、
nothingしなくても、コードの実行が終了した時点で自動的に解放されます。
 
ただモジュールレベルなどで宣言していたり、Static(静的変数)で宣言していると、コードの実行が終了しても残っているのでnothingは必ず必要になります。
 
まぁきちんとnothingする方が行儀は良いですね。
 
最後に上記の式は以下のように一回でセット出来ます。
   Dim myRng As Range

    Set myRng = Range(Cells(2, 24), Cells(lastR(0) + 1, 25))
    myRng.Formula = "=VLOOKUP(Sheet2!C2,Sheet6!I$2:J$" & lastR(3) & ",COLUMN(B1),FALSE)"
    myRng.Value = myRng.Value

    Set myRng = nothing

こんな感じで上手に数式を組み立てて、セット回数を減らせばもっと早くなると思います。
 
またVLOOKUPやMATCHなどの最後の引数がFALSEはTRUEの時に比べて数倍〜数十倍遅いので、TRUEで計算できるような、レイアウトの整理(昇順に並べるなど)や数式の組み立てを行なえば、全て処理しても1舜で終わるかも知れませんよ。

回答
投稿日時: 17/03/14 23:16:17
投稿者: mattuwan44

>c(1)だと、もしかして「1行目」ではなく「1列目」をさしてしまうのでしょうか??
ああああああああああぁぁぁ。
そうです。
 
c.cells(1)
 
ですね^^;
 
>Application.Range(c(2), c(c.Count)
Application.Range(c.cells(1), c(c.cells.Count)
 
う〜ん。間違い易いですね^^;
他もバグがあるかも^^;失礼しました。

回答
投稿日時: 17/03/14 23:19:23
投稿者: mattuwan44

>"=Vlookup(D3,データ,5,0)"
あ、↑の「データ」とは、
セル範囲に例えば「データ」と名付けたとして、数式を書いてます。
 
よく見るとマジックナンバーをどうにかしたい気もしますが、
まずはやりたいことをちゃんと説明していただいてからかもですねぇ。。。

回答
投稿日時: 17/03/14 23:21:41
投稿者: mattuwan44

あ、たびたびすみません。
 
やってることはsyさんと変わりなく、
セル範囲に数式をセットしてるだけです。
 
セル範囲をどう表現するかが違うのかなぁと思ってますが、
ちゃんと読んでないのでなんとも^^;

投稿日時: 17/03/15 21:49:48
投稿者: iori_y

頂いたアドバイスを試したところ、IF文での判定部分で時間が掛かるようです。
以下、今日試したコードを貼り付けます。
(試行錯誤中なので、書いているけど使っていないものも多々あります)
 
売上データは、A列〜V列までが売上に関するデータがあり、W・X・Y・Z・AA・AB列でそれぞれ支店などを表示するように数式を設定しています。
 

Dim WS(6) As Worksheet
Dim 元データ As Range
Dim リスト(5) As Range
――――――――――――――――――――――――――――――――――――――――
Sub WS代入()
    Set WS(1) = ThisWorkbook.Worksheets("集計対象")
    Set WS(2) = ThisWorkbook.Worksheets("売上データ")
    Set WS(3) = ThisWorkbook.Worksheets("【PVT】")
    Set WS(6) = ThisWorkbook.Worksheets("部内コード")
End Sub
――――――――――――――――――――――――――――――――――――――――
Sub 範囲取得() 'ここでは固定されている(めったに更新されない)データテーブルの範囲だけ取得
Call WS代入
    Set リスト(0) = WS(6).Range("支店名リスト")
    Set リスト(1) = WS(6).Range("部リスト")
    Set リスト(2) = WS(6).Range("担当営業リスト")
End Sub
――――――――――――――――――――――――――――――――――――――――
Sub 元データ範囲に名前を付ける()
Dim lastR As Long
Dim lastC As Long
Dim データ範囲 As Range
Call WS代入
  With WS(2)
    Set データ範囲 = Nothing
    lastR = .Cells(Rows.Count, 2).End(xlUp).Row
      lastC = 22
    
    Set データ範囲 = Range(.Cells(1, 1), .Cells(lastR, lastC))
        データ範囲.Name = "売上データ"
End With
    Set リスト(3) = WS(2).Range("売上データ")
End Sub
――――――――――――――――――――――――――――――――――――――――
Sub 判定数式()
Dim Start, Finish As Variant
Start = Time
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
Call WS代入
Call 範囲取得
 
Dim lastR(2) As Long
Dim myRng As Range
Dim i As Variant

    lastR(0) = WS(2).Cells(Rows.Count, 2).End(xlUp).Row '先月分データの最終行
    lastR(1) = WS(1).Cells(Rows.Count, 2).End(xlUp).Row '先月分の集計対象 最終行
 
'前月データの削除
    If lastR(0) > 1 Then
        WS(2).Range("W2:AB" & lastR(0)).ClearContents
    End If

  '******************************************
  '「売上データ」シートにて担当営業/外部調達品などの判定結果を表示させる
  '******************************************
  Call 元データ範囲に名前を付ける
  With WS(2)
   '支店名
    lastR(2) = リスト(3).Rows.Count
    Set myRng = Range(.Cells(2, 24), .Cells(lastR(2), 24))
    myRng.Formula = "=Vlookup(C2,支店名リスト,2,FALSE)"
    myRng.Value = myRng.Value

    '部名
    Set myRng = Range(Cells(2, 25), Cells(lastR(2), 25))
    myRng.Formula = "=Vlookup(D2,部リスト,2,FALSE)"
    myRng.Value = myRng.Value
 
    '支店名+部名
    Set myRng = Range(Cells(2, 26), Cells(lastR(2), 26))
    myRng.Formula = "=CONCATENATE(X2,Y2)"
    myRng.Value = myRng.Value
 
    '担当営業
    Set myRng = Range(Cells(2, 23), Cells(lastR(2), 23))
    myRng.Formula = "=VLOOKUP(Z2,担当営業リスト,2,0)"
    myRng.Value = myRng.Value
 
    '調達品は○、それ以外は×を表示   ・・・★★ここから
    Set myRng = Range(Cells(2, 27), Cells(lastR(2), 27))
    myRng.Formula = "=IF(AND(V2=""999C"",LEFT(C2,1)=""2"",OR(D2=""2"",D2=""5"",D2=""6"",D2=""9"")),""○"",""×"")" '"=対象判定(H2,V2,C2,D2)"
    myRng.Value = myRng.Value

     '×だったものの品番を表示
    Set myRng = Range(Cells(2, 28), Cells(lastR(2), 28))
    myRng.Formula = "=IF(AA2=""○"","""",H2)"  ' "=対象品番(AA2,H2)"
    myRng.Value = myRng.Value
   '・・・・・・・・・・・・・・・・・・・・★★ここまで
    Set myRng = Nothing

  '***********************************************
  '対象判定が"×"の品番の重複を抜いた品番を「集計対象」シートに貼り付ける
  'Office TANAKA - Excel VBA Tips[重複しないリストを作る]参考
  'http://officetanaka.net/excel/vba/tips/tips80.htm
  '***********************************************
    '「集計対象」シートにある先月分の削除
    If lastR(1) > 0 Then
        WS(1).Range("B1:B" & lastR(1)).ClearContents
    End If
 
    '重複なし品番を抽出し、「集計対象」シートに表示させる
    Dim Dic, buf As String, Keys
        Set Dic = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    For i = 2 To lastR(0)
        buf = .Cells(i, 28)
        Dic.Add buf, buf
    Next i
    ''出力
    Keys = Dic.Keys
    For i = 0 To Dic.Count - 1
        WS(1).Cells(i + 1, 2) = Keys(i)
    Next i
    Set Dic = Nothing
 
    '重複なしリストから空白セルを削除し、書式を文字列に変更する
     With WS(1)
         lastR(5) = .Cells(Rows.Count, 2).End(xlUp).Row
         For i = 1 To lastR(5)
             If .Cells(i, 2).Value = "" Then .Rows(i).Delete
         Next i
     End With
 
   End With
Call 品番重複除去
Call 集計
Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual

Finish = Time
MsgBox "データの加工を行いました。" & vbLf & "実行時間は" & Format(Finish - Start, "nn分ss秒") & "でした"
End Sub

 
これで(呼び出している「品番重複除去」と「集計」を入れて)30〜40秒になってしまいました。
コード内部に書いてある★★〜★★をコメントアウトして実行すると、全部で5秒程で完了しました。
ここまできたので、できれば「5秒」にもって行けたらと思っています。
アドバイスをお願いします。
ちなみに、上のコードで現在コメントアウトしている数式は以下の通りユーザー関数で作成しています。
 
Function 対象判定(品番 As Variant, 納品先 As Variant, 支店 As Variant, 部 As Variant) As String

'=IF(H2="","",IF(AND(V2="999C",LEFT(C2,1)="2",OR(D2="2",D2="5",D2="6",D2="9")),"○","×"))
'品番(H列)が空欄なら空欄、納品先(V列)が999C、支店(C列)が2始まりで、部が2,5,6,9の時は○、それ以外は×
Dim 結果 As String
    If 品番 <> "" Then
        If 振事 = 999C And Left(支店, 1) = "2" Then
            If 部 = 1 Or 部 = 4 Or 部 = 5 Or 部 = 9 Then
                結果 = "○"
           Else
                結果 = "×"
            End If
        Else
            結果 = "×"
        End If
    Else
        結果 = ""
    End If
 
   対象判定 = 結果
End Function
――――――――――――――――――――――――――――――――――――――
Function 対象品番(判定結果 As String, 品番 As String) As String
Dim 結果 As String
    If 判定結果 = "×" Then
        結果 = 品番
    Else
        結果 = ""
    End If
    
    対象品番 = 結果
End Function 

 
もしかしたら、SUBのほうで直接IF文で分岐させたほうが早いのかも?と今思いながら書いていますが、現状はこのようになっています。
 
 
mattuwan44 さんから頂いたコードですが、
    For Each c In rngTable.Columns 
         Select Case c.cells(1).Value 
             Case "集計対象か否か"   
                 strFormula = "=Vlookup(D3,データ,2,0)" 
             Case "実績" 
                 strFormula = "=Vlookup(D3,データ,5,0)" 
         End Select 
  
         Application.Range(c.cells(2), c(c.Count)).Formula = strFormula  ’←★★
     Next 

 
試したときは範囲指定をRange("A1").CurrentRegionのまま使用しましたが、★★のところに来た瞬間に、全てのデータが消えてしまいました。
どこを直したらよいか判らなくて、消えてしまうことしか確認できませんでした。
すみません。

回答
投稿日時: 17/03/15 23:09:48
投稿者: sy

iori_y さんの引用:
頂いたアドバイスを試したところ、IF文での判定部分で時間が掛かるようです。
    '調達品は○、それ以外は×を表示   ・・・★★ここから
    Set myRng = Range(Cells(2, 27), Cells(lastR(2), 27))
    myRng.Formula = "=IF(AND(V2=""999C"",LEFT(C2,1)=""2"",OR(D2=""2"",D2=""5"",D2=""6"",D2=""9"")),""○"",""×"")" '"=対象判定(H2,V2,C2,D2)"
    myRng.Value = myRng.Value

     '×だったものの品番を表示
    Set myRng = Range(Cells(2, 28), Cells(lastR(2), 28))
    myRng.Formula = "=IF(AA2=""○"","""",H2)"  ' "=対象品番(AA2,H2)"
    myRng.Value = myRng.Value
   '・・・・・・・・・・・・・・・・・・・・★★ここまで

これで(呼び出している「品番重複除去」と「集計」を入れて)30〜40秒になってしまいました。
コード内部に書いてある★★〜★★をコメントアウトして実行すると、全部で5秒程で完了しました。
ここまできたので、できれば「5秒」にもって行けたらと思っています。

ちょっとまだよく分かってないんですけど?
★★は提示されているIF判定してるだけの数式をセルに直接入力する方法で実行してるみたいですけど、本当にこの数式で30〜40秒もかかるんですか?
ちょっとあり得ないですね?
 
この数式を手で目的のセル範囲に貼り付けても相当待たされますか?
もし手で貼り付けて一瞬で計算されるなら、別に原因があります。
 
 
iori_y さんの引用:
ちなみに、上のコードで現在コメントアウトしている数式は以下の通りユーザー関数で作成しています。
 
Function 対象判定(品番 As Variant, 納品先 As Variant, 支店 As Variant, 部 As Variant) As String

'=IF(H2="","",IF(AND(V2="999C",LEFT(C2,1)="2",OR(D2="2",D2="5",D2="6",D2="9")),"○","×"))
'品番(H列)が空欄なら空欄、納品先(V列)が999C、支店(C列)が2始まりで、部が2,5,6,9の時は○、それ以外は×
Dim 結果 As String
    If 品番 <> "" Then
        If 振事 = 999C And Left(支店, 1) = "2" Then
            If 部 = 1 Or 部 = 4 Or 部 = 5 Or 部 = 9 Then
                結果 = "○"
           Else
                結果 = "×"
            End If
        Else
            結果 = "×"
        End If
    Else
        結果 = ""
    End If
 
   対象判定 = 結果
End Function
――――――――――――――――――――――――――――――――――――――
Function 対象品番(判定結果 As String, 品番 As String) As String
Dim 結果 As String
    If 判定結果 = "×" Then
        結果 = 品番
    Else
        結果 = ""
    End If
    
    対象品番 = 結果
End Function 


まあ基本ユーザー定義関数はどんなに頑張ってコーディングしても、同じ機能を持ったワークシート関数に比べると遅いです。
理由は使用言語の差で、ワークシート関数を記述してる内部コードの方が、VBAより数倍〜数百倍高速だからです。
ユーザー定義関数のメリットはワークシート関数では実現が難しい処理を簡単な引数で実現できるようにする事です。
早くする事は出来ないと思って、まぁ間違いはないと思います。(例外があったらすいません)
 
 
後VLOOKUPの式ですがエラー処理は必要無いんですか?
検索の型がFALSEになってると見つからなければエラーになると思いますが大丈夫なんですか?
もし100%検索値が見つかるのが保証されているなら、支店名リスト・部リスト・担当営業リストを、それぞれ昇順で並べ替えておけば、
"=Vlookup(C2,支店名リスト,2,TRUE)"

こんな感じで検索の型をTRUEにすれば、数倍〜数十倍速くなります。
 
 
何れにしても、一度手で貼り付けて早さを見て下さい。
手で貼り付けると、一瞬で計算されそうな気がします。
その結果を教えて頂けますか。
 
それとやはりまずは集計してるシートだけでもレイアウトを提示して頂けませんか。
コードと説明文だけでは全体像が見えてきません。
もしかしたら、もっと別の原因があるかも知れませんね。

回答
投稿日時: 17/03/16 13:13:50
投稿者: mattuwan44

コードが、冗舌ですね。
もっとシンプルにセル範囲を表現したいですね。
 
Sub 判定数式2()
    Dim rngTable As Range
    Dim t
 
    '表の範囲取得
    With ThisWorkbook.Worksheets("売上データ")
        Set rngTable = Application.Range(.Cells(2, "A"), .Cells(.Rows.Count, "V").End(xlUp))
    End With
 
    With rngTable.Range("W:AB")
        '前月データのクリア
        .EntireColumn.ClearContents
         
        Application.Calculation = xlCalculationManual
            '数式のセット
        .Columns(2).Formula = "=Vlookup(C2,支店名リスト,2,FALSE)" '支店名
        .Columns(3).Formula = "=Vlookup(D2,部リスト,2,FALSE)" '部名
        .Columns(4).Formula = "=CONCATENATE(X2,Y2)" '支店名+部名
        .Columns(1).Formula = "=VLOOKUP(Z2,担当営業リスト,2,0)" '担当営業
        '調達品は○、それ以外は×を表示   ・・・★★ここから
        .Columns(6).Formula = "=IF(AND(V2=""999C"",LEFT(C2,1)=""2"",OR(D2=""2"",D2=""5"",D2=""6"",D2=""9"")),""○"",""×"")" '"=対象判定(H2,V2,C2,D2)"
        '×だったものの品番を表示
        .Columns(7).Formula = "=IF(AA2=""○"","""",H2)" ' "=対象品番(AA2,H2)"
        Application.Calculation = xlCalculationAutomatic
 
        .Value = .Value
 
        '作業列で処理
        With .Columns(9)
            .Value = Columns(7).Value
            '空白除去
            .Sort key1:=.Cells(1), order1:=xlAscending, Header:=xlNo
            '品番重複除去
            .RemoveDuplicates Columns:=1, Header:=xlNo
        End With
    End With
 
    MsgBox Timer - t & "秒"
End Sub
 
空白除去は並び替えを使うと速いです。
重複削除もエクセルの標準機能に備わっています。
(dictionaryとどっちが速いかは、僕は知りません。気にならないので^^;)
 
>SUBのほうで直接IF文で分岐させたほうが早いのかも?
おまけ機能が本家にはなかなか勝てないと思います。
本家に任せられるところは任せた方が速いとは限りませんが、気が楽です。

回答
投稿日時: 17/03/16 13:15:10
投稿者: mattuwan44

Application.Calculation = xlCalculationAutomatic
 
って書いたら再計算もついでにしてくれるんでしたっけ?

回答
投稿日時: 17/03/16 13:17:17
投稿者: mattuwan44

>.Value = Columns(7).Value
 
ごめん。ピリオドがぬけていました。
 
.Value = .Columns(7).Value
 
動作確認はしてませんので、悪しからずご了承願います。

投稿日時: 17/03/16 23:39:55
投稿者: iori_y

syさん mattuwan44さん
 
お付き合いいただいてありがとうございます。
 
まだどこかで”配列を解くための公式”みたいなものを求めている自分がいるので(人によって変わるので公式なんてものはないことは百も承知ですが)、なかなか理解に時間が掛かってしまい申し訳ないですが、よろしくお願いします。
 
表のレイアウトを、ということでしたので、社内用語で置き換え不可の場所は*印をつかってタイトルをごまかしています。
仮のデータも、数式に必要なところだけ置き換えてみました。
元は別のシステムから持ってきているテキストデータですので、全て文字列として認識されています。
 

売上月    出荷日    支店       部           得意先    得意先名称           記号       製品品番              *             **            出荷数    原価金額    販売金額              利益       区分       品種       出荷種別              販売種別              伝票番号              ****         納入先       *****        担当営業              支店       部名    支店+部名

2017/02 2017/1/24            0010A    2                                                                                                100        8000              100000  92000                  2                                                                                                佐藤       北海道    販売店       北海道販売店

2017/02 2017/1/24            9800A    2                                                                                                60          3240              16800    13560                  2                                                                                                東           宮城       販売店       宮城販売店

2017/02 2017/1/27            0010A    2                                                                                                100        8000              98000    90000                  3                                                                                                佐藤       北海道    販売店       北海道販売店

2017/02 2017/1/27            9800A    2                                                                                                200        30000              20000    -10000                 3                                                                                                東           宮城       販売店       宮城販売店

2017/02 2017/1/24            1400B    2                                                                                                180        25920              140400  114480                2                                                                                                山口       東京西部              販売店    東京西部販売店

2017/02 2017/1/27            9999C    3                                                                                                50          2000              7500      5500                    3                                                                                                ‐           本社(外部)                            本社(外部)

2017/02 2017/1/27            9999C    3                                                                                                200        32000              20000    -12000                 2                                                                                                ‐           本社(外部)                            本社(外部)

2017/02 2017/1/28            1400A    2                                                                                                60          3240              16800    13560                  2                                                                                                井上       東京       販売店       東京販売店

2017/02 2017/1/28            9999C    3                                                                                                50          2000              7500      5500                    2                                                                                                ‐           本社(外部)                            本社(外部)

 

 
横長の表ですので、画面上では見づらいですよね。
こういう場合、貼り付けるだけでいいのでしょうか・・・。
 
引用:
この数式を手で目的のセル範囲に貼り付けても相当待たされますか?

元々使っていた数式ですので、ワークシートに直接貼り付けたほうが早いです。
ですが、データが多いと「再計算 ○%」と画面右下に出てくることが多いです。
これはPCの処理能力のせいでもあるので、頑張った結果、それでもある程度時間が掛かってしまうのは仕方ないかもとあきらめてはいます。
 
 
引用:
後VLOOKUPの式ですがエラー処理は必要無いんですか?

大々的な組織変更がない限りはコード新設がおきることはないので、逆にエラーを表示しておいたほうがいいかなと思っています。
この指摘で、エラーが出たときは「エラーがある」ことをお知らせするメッセージを表示したほうがいいかな、と思いました。
 
 
引用:
空白除去は並び替えを使うと速いです。
 重複削除もエクセルの標準機能に備わっています。
(dictionaryとどっちが速いかは、僕は知りません。気にならないので^^;)

最初、[ジャンプ] →[空白セル]のコードを設定したのですが、いつのまにか文字数0の空白になっていたのでこの「文字数0の空白」を削除するコードを設定しました。
ところが、今日何度か試しているとただの空白セルになっていたので「文字数0の空白」では削除されないことに気付きました(データのせい?)
ここはもう少し考えないとダメなのかなと思っています。
フィルタオプションで重複削除したほうが楽かな・・・。
 
 
ユーザー関数については、お2人の意見でサクッと使うのをやめることにしました。
 
 
念のため、残りの二つのSubも持ってこようと思っていましたが、表だけ持ってきて失念していました。
手間ばかりかけてすみません、明日持ってきます。

投稿日時: 17/03/16 23:44:40
投稿者: iori_y

売上月    出荷日    支店       部           得意先    得意先名称           記号       製品品番              *             **            出荷数    原価金額    販売金額              利益       区分       品種       出荷種別              販売種別              伝票番号              ****         納入先       *****        担当営業              支店       部名    支店+部名

支店+部名 の横に、「集計対象か否か」と「対象品番」という列があります。
すみません、抜けてしまいました。

回答
投稿日時: 17/03/17 07:33:41
投稿者: sy

iori_y さんの引用:

元々使っていた数式ですので、ワークシートに直接貼り付けたほうが早いです。
ですが、データが多いと「再計算 ○%」と画面右下に出てくることが多いです。
これはPCの処理能力のせいでもあるので、頑張った結果、それでもある程度時間が掛かってしまうのは仕方ないかもとあきらめてはいます。

そうですか、IFの条件式で実際に遅いんですね。
ちょっともう仕事なので帰ってからコードはアップするとして、手順だけ以下に示します。
目的のセル(すいません列忘れました)を全て×にして、
フィルターオプションで同じ場所に抽出で〇になる分だけ抽出して、
ジャンプの可視セルを選択して〇に変更すれば数式よりは早いと思います。

回答
投稿日時: 17/03/17 20:27:51
投稿者: mattuwan44

あぁ。。。
 
(AND(V2="999C",LEFT(C2,1)="2",OR(D2="2",D2="5",D2="6",D2="9"))
この数式に該当するものを先に
フィルターオプションで抜き出せば、
数式をセットする量が減らせるので、
再計算の時間が短縮できます。
 
そもそもデータベースとなるデータに書き足したらまずいでしょう。
そしてデータベースから必要なデータを抽出してから、
見せる最低限のデータにしてから、
見栄えのいいように加工(計算等)しましょう^^
 

回答
投稿日時: 17/03/18 05:36:36
投稿者: sy

レイアウトを提示して頂いたので分かった事があります。
コードの全文と合わせて見直してみましたけど、
以下の事は、単に「条件に合った品番を重複無しに集計対象シートに転記したい」だけですよね?

iori_y さんの引用:
 
    '調達品は○、それ以外は×を表示   ・・・★★ここから
    Set myRng = Range(Cells(2, 27), Cells(lastR(2), 27))
    myRng.Formula = "=IF(AND(V2=""999C"",LEFT(C2,1)=""2"",OR(D2=""2"",D2=""5"",D2=""6"",D2=""9"")),""○"",""×"")" '"=対象判定(H2,V2,C2,D2)"
    myRng.Value = myRng.Value

     '×だったものの品番を表示
    Set myRng = Range(Cells(2, 28), Cells(lastR(2), 28))
    myRng.Formula = "=IF(AA2=""○"","""",H2)"  ' "=対象品番(AA2,H2)"
    myRng.Value = myRng.Value
   '・・・・・・・・・・・・・・・・・・・・★★ここまで
    Set myRng = Nothing

  '***********************************************
  '対象判定が"×"の品番の重複を抜いた品番を「集計対象」シートに貼り付ける
  'Office TANAKA - Excel VBA Tips[重複しないリストを作る]参考
  'http://officetanaka.net/excel/vba/tips/tips80.htm
  '***********************************************
    '「集計対象」シートにある先月分の削除
    If lastR(1) > 0 Then
        WS(1).Range("B1:B" & lastR(1)).ClearContents
    End If
 
    '重複なし品番を抽出し、「集計対象」シートに表示させる
    Dim Dic, buf As String, Keys
        Set Dic = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    For i = 2 To lastR(0)
        buf = .Cells(i, 28)
        Dic.Add buf, buf
    Next i
    ''出力
    Keys = Dic.Keys
    For i = 0 To Dic.Count - 1
        WS(1).Cells(i + 1, 2) = Keys(i)
    Next i
    Set Dic = Nothing
 
    '重複なしリストから空白セルを削除し、書式を文字列に変更する
     With WS(1)
         lastR(5) = .Cells(Rows.Count, 2).End(xlUp).Row
         For i = 1 To lastR(5)
             If .Cells(i, 2).Value = "" Then .Rows(i).Delete
         Next i
     End With
 
   End With
Call 品番重複除去
Call 集計

なら、こんな回りくどい事をしなくても、フィルターオプションで品番を抽出して、集計対象シートに転記すれば良いです。
AA・AB列のIF判定や、Dictionaryも全く必要ないですね。
もっと言ったら、集計対象シートのB1セルに項目名があれば、フィルターオプションで直接抽出結果を表示させる事も可能です。
 
以下のコードだけで上記の部分を全て実現できます。
(元データはA2〜Zの最終行に変更してます)
(集計対象シートのB1に「製品品番」と予め項目名を入れておきます、入れる事が出来ないなら一旦別セルに抽出してから転記になりますね)
    '調達品以外の品番を「集計対象」シートに貼り付ける
    With WS(2).Range("AD1:AJ4")
        .ClearContents
        .Rows(1).Value = Array("支店CD", "支店", "部", "部", "部", "部", "製品品番")
        .Rows(2).Value = Array("<>999C", , , , , , "<>")
        .Rows(3).Value = Array(, "<>2*", , , , , "<>")
        .Rows(4).Value = Array(, , "<>2*", "<>5*", "<>6*", "<>9*", "<>")
    End With
    元データ.CurrentRegion.AdvancedFilter xlFilterCopy, WS(2).Range("AD1:AJ4"), WS(1).Range("B1"), True

条件欄のセルも予め上記の内容で用意しておけるなら、
元データ.CurrentRegion.AdvancedFilter xlFilterCopy, WS(2).Range("AD1:AJ4"), WS(1).Range("B1"), True

のたったの1行だけで、IF判定から重複や空欄の削除と転記までを全て実現出来ます。
条件欄のレイアウトは以下です。
	AD	AE	AF	AG	AH	AI	AJ
1	支店CD	支店	部	部	部	部	製品品番
2	<>999C						<>
3		<>2*					<>
4			<>2*	<>5*	<>6*	<>9*	<>

 
条件欄や集計対象シートのB1に項目を予め入れれるなら、
投稿者: iori_y 投稿日時: 17/03/15 21:49:48 で提示されたコードの無駄な部分を修正したら以下で行けると思います。
ただVLOOKUPの部分は、式を全て代入してから値変換してるので、遅いようなら判定数式2のように1列づつ値に変換の方が良いですね。
データ量に合わせて使い分け出来ると思います。
Option Explicit

Dim WS(6) As Worksheet

Sub WS代入()
    
    Set WS(1) = ThisWorkbook.Worksheets("集計対象")
    Set WS(2) = ThisWorkbook.Worksheets("売上データ")
    Set WS(3) = ThisWorkbook.Worksheets("【PVT】")
    Set WS(6) = ThisWorkbook.Worksheets("部内コード")

End Sub

Sub 判定数式()
    Dim 元データ As Range
    Dim lastR As Long
    Dim t As Double
    t = Timer

    Application.ScreenUpdating = False

    Call WS代入
    lastR = WS(2).Cells(Rows.Count, "B").End(xlUp).Row
    Set 元データ = WS(2).Range("A2", WS(2).Cells(lastR, "Z"))

    '「売上データ」シートにて担当営業/外部調達品などの判定結果を表示させる
    With 元データ
        .Columns(23).Formula = "=VLOOKUP(Z2,担当営業リスト,2,FALSE)" '担当営業
        .Columns(24).Formula = "=VLOOKUP(C2,支店名リスト,2,FALSE)"  '支店名
        .Columns(25).Formula = "=VLOOKUP(D2,部リスト,2,FALSE)"  '部名
        .Columns(26).Formula = "=X2&Y2"  '支店名+部名
        .Value = .Value
    End With

    '調達品以外の品番を「集計対象」シートに貼り付ける
    元データ.CurrentRegion.AdvancedFilter xlFilterCopy, WS(2).Range("AD1:AJ4"), WS(1).Range("B1"), True

    Application.ScreenUpdating = True

    MsgBox "データの加工を行いました。" & vbLf & "実行時間は" & Round(Timer - t, 2) & "秒でした"

End Sub


Sub 判定数式2()
    Dim 元データ As Range
    Dim lastR As Long
    Dim t As Double
    t = Timer

    Application.ScreenUpdating = False

    Call WS代入
    lastR = WS(2).Cells(Rows.Count, "B").End(xlUp).Row
    Set 元データ = WS(2).Range("A2", WS(2).Cells(lastR, "Z"))

    '「売上データ」シートにて担当営業/外部調達品などの判定結果を表示させる
    With 元データ.Columns(23)
        .Formula = "=VLOOKUP(Z2,担当営業リスト,2,FALSE)" '担当営業
        .Value = .Value
    End With
    With 元データ.Columns(24)
        .Formula = "=VLOOKUP(C2,支店名リスト,2,FALSE)"  '支店名
        .Value = .Value
    End With
    With 元データ.Columns(25)
        .Formula = "=VLOOKUP(D2,部リスト,2,FALSE)"  '部名
        .Value = .Value
    End With
    With 元データ.Columns(26)
        .Formula = "=X2&Y2"  '支店名+部名
        .Value = .Value
    End With

    '調達品以外の品番を「集計対象」シートに貼り付ける
    元データ.CurrentRegion.AdvancedFilter xlFilterCopy, WS(2).Range("AD1:AJ4"), WS(1).Range("B1"), True

    Application.ScreenUpdating = True

    MsgBox "データの加工を行いました。" & vbLf & "実行時間は" & Round(Timer - t, 2) & "秒でした"

End Sub

今回も初めにレイアウトを提示して頂いていたら、解決も早かったかも知れません。
やり取りをスムーズにする為にも、初めの投稿でレイアウトを提示するように心掛けて下さい。

回答
投稿日時: 17/03/18 19:15:00
投稿者: sy

判定数式2の方は、数式を挿入する順番が大事でしたね。
すいません。
 
後Z列も必要無いんじゃないですか?
表示させる必要が無いならVLOOKUPの第一引数をX2&Y2にするだけです。
省略すればZ列のコピペの作業が減るので当然早くなります。
 
以下Z列も省略した修正版です。(これが一番早いですね)
これで簡単なサンプル15000件で品番が1000件くらい抽出で私の環境で0.8秒でした。
データ次第で変わりますが大幅な速度改善が出来てると思います。

Sub 判定数式2()
    Dim 元データ As Range
    Dim lastR As Long
    Dim t As Double
    t = Timer

    Application.ScreenUpdating = False

    Call WS代入
    lastR = WS(2).Cells(Rows.Count, "B").End(xlUp).Row
    Set 元データ = WS(2).Range("A2", WS(2).Cells(lastR, "Y"))

    '「売上データ」シートにて担当営業/外部調達品などの判定結果を表示させる
    With 元データ.Columns(24)
        .Formula = "=VLOOKUP(C2,支店名リスト,2,FALSE)"  '支店名
        .Value = .Value
    End With
    With 元データ.Columns(25)
        .Formula = "=VLOOKUP(D2,部リスト,2,FALSE)"  '部名
        .Value = .Value
    End With
    With 元データ.Columns(23)
        .Formula = "=VLOOKUP(X2&Y2,担当営業リスト,2,FALSE)" '担当営業
        .Value = .Value
    End With

    '調達品以外の品番を「集計対象」シートに貼り付ける
    元データ.CurrentRegion.AdvancedFilter xlFilterCopy, WS(2).Range("AD1:AJ4"), WS(1).Range("B1"), True

    Application.ScreenUpdating = True

    MsgBox "データの加工を行いました。" & vbLf & "実行時間は" & Round(Timer - t, 2) & "秒でした"

End Sub

回答
投稿日時: 17/03/19 10:29:22
投稿者: mattuwan44

「売上データ」シート>>

                                                                                        
                                                                                        
                                                                                
       [A]    [B]    [C]    [D]   [E]    [F]     [G]      [H]     [I]   [J  [V  
                                                                        ]   ]   
    ┌───┬──┬───┬──┬──┬───┬───┬────┬──┬─┬─┐
    │ 売上 │出荷│      │    │得意│得意先│      │        │    │  │**│
  1]│  月  │ 日 │ 支店 │ 部 │ 先 │ 名称 │ 記号 │製品品番│ *  │**│**│
    │      │    │      │    │    │      │      │        │    │  │* │
    ├───┼──┼───┼──┼──┼───┼───┼────┼──┼─┼─┤
  2]│ 17/02│1/24│2010A │   2│ 100│  8000│100000│   92000│   2│  │99│
    │      │    │      │    │    │      │      │        │    │  │9C│
    ├───┼──┼───┼──┼──┼───┼───┼────┼──┼─┼─┤
  3]│ 17/02│1/24│1400B │   2│ 180│ 25920│140400│  114480│   2│  │  │
    ├───┼──┼───┼──┼──┼───┼───┼────┼──┼─┼─┤
  4]│ 17/02│1/24│9800A │   2│  60│  3240│ 16800│   13560│   2│  │  │
    ├───┼──┼───┼──┼──┼───┼───┼────┼──┼─┼─┤
  5]│ 17/02│1/27│ 0010A│   2│ 100│  8000│ 98000│   90000│   3│  │99│
    │      │    │      │    │    │      │      │        │    │  │9C│
    ├───┼──┼───┼──┼──┼───┼───┼────┼──┼─┼─┤
  6]│ 17/02│1/27│9800A │   2│ 200│ 30000│ 20000│  -10000│   3│  │  │
    ├───┼──┼───┼──┼──┼───┼───┼────┼──┼─┼─┤
  7]│ 17/02│1/27│9999C │   3│ 200│ 32000│ 20000│  -12000│   2│  │  │
    ├───┼──┼───┼──┼──┼───┼───┼────┼──┼─┼─┤
  8]│ 17/02│1/27│9999C │   3│  50│  2000│  7500│    5500│   3│  │  │
    ├───┼──┼───┼──┼──┼───┼───┼────┼──┼─┼─┤
  9]│ 17/02│1/28│2400A │   2│  60│  3240│ 16800│   13560│   2│  │99│
    │      │    │      │    │    │      │      │        │    │  │9C│
    ├───┼──┼───┼──┼──┼───┼───┼────┼──┼─┼─┤
  10│ 17/02│1/28│9999C │   3│  50│  2000│  7500│    5500│   2│  │  │
   ]│      │    │      │    │    │      │      │        │    │  │  │
    └───┴──┴───┴──┴──┴───┴───┴────┴──┴─┴─┘


 
「部内コード」シート>>
┌──┬────┬─┬─┬────┬─┬──────────┬───┐
│支店│支店    │  │部│部      │  │支店+部名           │担当営│
│    │        │  │  │        │  │                    │業    │
├──┼────┼─┼─┼────┼─┼──────────┼───┤
│2010│北海道  │  │ 2│販売店  │  │北海道販売店        │佐藤  │
│A   │        │  │  │        │  │                    │      │
├──┼────┼─┼─┼────┼─┼──────────┼───┤
│1400│東京西部│  │ 3│本社(外│  │東京西部販売店      │山口  │
│B   │        │  │  │部)    │  │                    │      │
├──┼────┼─┼─┼────┼─┼──────────┼───┤
│9800│宮城    │  │  │        │  │宮城販売店          │東    │
│A   │        │  │  │        │  │                    │      │
├──┼────┼─┼─┼────┼─┼──────────┼───┤
│9999│本社(外│  │  │        │  │本社(外部)本社(外│‐    │
│C   │部)    │  │  │        │  │部)                │      │
├──┼────┼─┼─┼────┼─┼──────────┼───┤
│2400│東京    │  │  │        │  │東京販売店          │井上  │
│A   │        │  │  │        │  │                    │      │
└──┴────┴─┴─┴────┴─┴──────────┴───┘

 
「抽出条件」シート>>
┌───┬──┬──┐
│***** │支店│部  │
├───┼──┼──┤
│<>999C│<>2*│<>2 │
├───┼──┼──┤
│<>999C│<>2*│<>5 │
├───┼──┼──┤
│<>999C│<>2*│<>6 │
├───┼──┼──┤
│<>999C│<>2*│<>9 │
└───┴──┴──┘

 
「集計対象」シート>>
┌────┬──┬─┬────┐
│担当営業│支店│部│製品品番│
└────┴──┴─┴────┘

 
シートの構成がこのようになっているとして、
 
Option Explicit

Sub メイン()
    Dim rngOldData As Range         '元データのセル範囲(別途出力されたテキストファイル)
    Dim wshResulte As Worksheet     '結果出力シート
    
    'オブジェクトの取得
    Set rngOldData = ThisWorkbook.Worksheets("売上データ").Range("A1").CurrentRegion
    Set wshResulte = ThisWorkbook.Worksheets("集計対象")
    
    '作業
    Call データの抽出(wshResulte, rngOldData)
    Call コード2名称_変換(wshResulte)
    'Call 集計(wshResulte)
End Sub

Sub データの抽出(ByVal ws As Worksheet, ByVal Rng As Range)
    Rng.AdvancedFilter _
            Action:=xlFilterCopy, _
            CriteriaRange:=ThisWorkbook.Worksheets("抽出条件").Range("A1:C5"), _
            CopyToRange:=ws.Range("B1:D1"), _
            Unique:=True
End Sub

Sub コード2名称_変換(ByVal ws As Worksheet)
    Dim c As Range

    With ws.Range("A1").CurrentRegion
        With Intersect(.Cells, .Offset(1))
            For Each c In Application.Range("支店リスト").Rows
                .Columns(2).Replace c.Cells(1), c.Cells(2)
            Next
            For Each c In Application.Range("部リスト").Rows
                .Columns(3).Replace c.Cells(1), c.Cells(2)
            Next
            With .Columns(1)
                .Formula = "=VLOOKUP(B2&C2,担当営業リスト,2,0)"
                .Value = .Value
            End With
        End With
    End With
End Sub

 
このようなコードでいかがでしょうか?
まずはデータを絞りこんでからの方が無駄な作業が減らせると思うので、
高速化が見込めると思います。
あとは、コードを名称に変換する部分の高速化かな?
その辺は僕は解らないので、再度タイトルを変えて質問をして、
テクニックを教えてもらうといいかなと思います。
 
あ、syさんと抽出条件の表が違いますねー。。。
僕が要件を理解できてないと思うので、
その辺はご自分のやりたいようにフィルターオプションの条件の表の作り方を
調べて作ってください。

回答
投稿日時: 17/03/20 18:44:27
投稿者: sy

mattuwan44 さんの引用:
あ、syさんと抽出条件の表が違いますねー。。。
僕が要件を理解できてないと思うので、
その辺はご自分のやりたいようにフィルターオプションの条件の表の作り方を
調べて作ってください。

ついでなので抽出条件表の作成方法について説明しておきます。
 
まず元の数式が以下です。
=IF(AND(V2="999C",LEFT(C2,1)="2",OR(D2="2",D2="5",D2="6",D2="9")),"○","×")
=IF(AA2="○","",H2)

上で×になったものを抽出したいと言う事ですが、品番には空白も存在するので以下のようになります。
=IF(OR(H2="",AND(V2="999C",LEFT(C2,1)="2",OR(D2="2",D2="5",D2="6",D2="9"))),"○","×")

ただこのままでは抽出したいのがFALSE側なので抽出できません。
なのでこの式で×がTRUE側に来るようにしなければいけません。
反対に持ってくるには「ANDとOR」「=と<>」が全て反対になれば良いです。
=IF(AND(H2<>"",OR(V2<>"999C",LEFT(C2,1)<>"2",AND(D2<>"2",D2<>"5",D2<>"6",D2<>"9"))),"×","〇")

これでTRUE側に×を持ってくる事が出来ました。
 
後はこれを条件欄に反映させるだけです。
ANDは右に、ORは下に条件を設定します。
一番外側にANDなので、全ての条件と同じ行に「品番の<>」をセットします。
次にORなので下方向にセットします、それぞれの項目名の列に「支店CD」「支店」「部」を行を変えてセットします。
最後にANDがあるので、「部」は同じ行にセットします。
支店の左1文字抽出はワイルドカード「*」を使って「<>2*」と表現します。
部は完全一致なので「<>2」などにしたい所ですが、これでは数値として認識されるので、数式中は"2"と文字として比較してるので文字として認識させるために「<>2*」「<>5*」のような表現になります。
 
最終的に反映させた形が以下になります。
ORなので支店CD,支店,部は行が変わる              品番は一番外側のANDなので全ての行にセット
支店CD	支店	部	部	部	部	製品品番
<>999C						<>
	<>2*					<>
		<>2*	<>5*	<>6*	<>9*	<>
                部はANDなので同じ行にセットする

投稿日時: 17/03/22 23:48:39
投稿者: iori_y

syさん mattuwan44 さん
 
すみません、急に忙しくなってしまって放置になってしまいました。
 
・教えていただいたコードを参考に
・とりあえず”ブックを開いた時”に全てのワークシートで”手動計算”に
・”ブックを閉じる時”に全てのワークシートで”自動”に
 
ということを設定して、8〜15秒位にはなりました。
(15秒の時は直後にoutlookのアラートが表示されたので、多分これのせいかと)
また、IFの条件についての説明、ありがとうございました。
この質問記事、ちょっと保管しておきたい位です。
 

引用:

そもそもデータベースとなるデータに書き足したらまずいでしょう。
そしてデータベースから必要なデータを抽出してから、
見せる最低限のデータにしてから、
見栄えのいいように加工(計算等)しましょう^^

私もそれがすごく気になるんですが、今いる部署はずっとそのように仕事をしてきているので急に色々は変えられない感じです。
マクロも「居なくなった後誰もいじれない」と言う意見もあるので、”見た目を変えずに”マクロを使うというのが私の出した結論です。
 
それでも、
引用:

後Z列も必要無いんじゃないですか?
表示させる必要が無いならVLOOKUPの第一引数をX2&Y2にするだけです。
省略すればZ列のコピペの作業が減るので当然早くなります。

確かにこのくらいなら、なくてもいいかな?とも思ったのでこっそり列を削除しました。
指摘されたら、元に戻すまでです(--;
 
 
お2人のコードを見ても、いろんな書き方があることがわかりますので、臨機応変な対応が出来るコードが書けるようになりたいです。
 
長い間お付き合いいただきましてありがとうございました。