VBAで配列にデータを格納し比較して出力する事はできますか？

Question

VBAで配列にデータを格納し比較して出力する事はできますか？

“単価抽出”シートに部品コード、単価情報が入っています。
★やりたい事は
A列4行目から部品コード
B列4行目から発注先
C列4行目から発注単価
D列4行目から実績単価
E列4行目から標準単価
が表示されています。
この情報を基に以下の条件で

H列4行目から『適応単価』を算出したいです。

1.部品先(B列)のコードが”A11”で且つ、部品コード(A列)のコード末尾が”-A”もしくは”-B”の場合、
’0円’を『適応単価』に表示
2.発注単価(C列)が’0円’の場合、実績単価(D列)を『適応単価』に表示。
3.実績単価(D列)が’0円’の場合、標準単価(E列)を『適応単価』に表示。
4.全て’0円’の場合は、’0円’を『適応単価』に表示

条件に合わせてループさせた以下のコードでできるのですが、
対象が数万になると非常に遅いです。

★データを配列に格納し条件に合わせて比較出力する事は可能でしょうか？
コードを教えて頂きたいです。

Sub 単価比較()

    Dim maxrow As Long
    Dim I As Long
  
        Application.ScreenUpdating = False
   
        With Sheets("単価抽出")
            .Cells(2, 8).Value = "適応単価"
            With .Range("A1").SpecialCells(xlLastCell)
                maxrow = .Row
            End With
    
            For I = 4 To maxrow
                    If .Cells(I, 3) = 0 Then
                        If .Cells(I, 4) = 0 Then
                            .Cells(I, 8) = .Cells(I, 5)
                        Else
                            .Cells(I, 8) = .Cells(I, 4)
                        End If
                    Else
                        .Cells(I, 8) = .Cells(I, 3)
                    End If
                 
                 If (.Cells(I, 2) = "DIP" And Right(Cells(I, 1), 2) = "-A") Or _
          (.Cells(I, 2) = "DIP" And Right(Cells(I, 1), 2) = "-J") Then
                    .Cells(I, 8) = 0
                 Else: End If
            Next I
        End With
        Application.ScreenUpdating = True
End Sub

Answer 1

セルに直接アクセスすると重くなるので、配列を介して軽くしたいということですね。

あと、言葉での要件とコードが乖離してますので、言葉の方の要件に合わせます。

言葉の要件ですが、もう少し精査して、必要十分なシンプルなものにしましょう。そうするとコードもシンプルにできます。

下記の条件を上から評価する
0. B列が”A11”で且つ、A列のが"-A"または"-B"の場合、『適応単価』は 0
0. C列が0でなければ、『適応単価』は C列の値
0. D列が0でなければ、『適応単価』は D列の値
0. E列が0でなければ、『適応単価』は E列の値

これをFunctionにすると、

Public Function 適応単価(a, b, c, d, e)
    If b = "A11" And a Like "*-[AB]" Then
        適応単価 = 0
    ElseIf c <> 0 Then
        適応単価 = c
    ElseIf d <> 0 Then
        適応単価 = d
    ElseIf e <> 0 Then
        適応単価 = e
    Else
        適応単価 = 0
    End If
End Function

あとは、下記をコード化するればOKです。
0. 比較範囲（レンジ）の値を配列に格納
0. 上記の関数で比較して結果を取得して、結果配列に格納
0. それを結果範囲のレンジに代入

Public Sub 単価比較()
    Dim maxrow As Long
    Dim I As Long
    Dim ary()    '比較範囲格納配列
    Dim aryRes() '結果格納配列

    With Sheets("単価抽出")
        .Cells(2, 8).Value = "適応単価"
        maxrow = .Range("A1").SpecialCells(xlLastCell).Row '最終行
        ary = .Range("A4:E" & maxrow).Value       
        ReDim aryRes(1 To UBound(ary), 1 To 1)
        For I = 1 To UBound(ary)
            aryRes(I, 1) = 適応単価(ary(I, 1), ary(I, 2), ary(I, 3), ary(I, 4), ary(I, 5))
        Next I
        .Range("H4", "H" & maxrow).Value = aryRes
    End With
End Sub

Comments

[cd987456]

回答ありがとうございます。
上手く処理できました。
私のコードだと６万行くらいのデータでフリーズしてしまいました。
教えて頂いたコードでは１秒とかかりません。
ありがとうございました。

Answer 2

以前回答した応用で処理できませんか？
https://teratail.com/questions/83782

Comments

[cd987456]

回答ありがとうございます。
先日、教えて頂いたばかりなのに上手く活用できませんでした。
勉強致します。
ありがとうございました。

Answer 3

1.部品先(B列)のコードが”A11”で且つ、部品コード(A列)のコード末尾が”-A”もしくは”-B”の場合、
’0円’を『適応単価』に表示
2.発注単価(C列)が’0円’の場合、実績単価(D列)を『適応単価』に表示。
3.実績単価(D列)が’0円’の場合、標準単価(E列)を『適応単価』に表示。
4.全て’0円’の場合は、’0円’を『適応単価』に表示

↑上記の条件ですが、発注単価(C列)が’0円’以外の場合はどうなりますか？
（発注単価(C列)が’0円’を『適応単価』に表示、でしょうか？）

以下、そうだと仮定して……。

質問への直接の回答でなくて恐縮ですが、H列に「適応単価」を表示する場合、VBAを使わなくても関数で良いような気がします。

H4列に

=IF(AND(B4="A11",OR(RIGHT(A4,2)="-A",RIGHT(A4,2)="-B")),"0円",IF(C4<>"0円",C4,IF(D4<>"0円",D4,E4)))

と書いていただくのはどうでしょう？

マクロで毎回１件ずつ処理するよりも、関数でその場で計算→値が変わった時だけ再計算のほうが早い気がします。

※『提示されたマクロ』と『日本語で書かれた要件』の内容が少々違っていたので、上記関数は『日本語で書かれた要件』に準拠しております。

Comments

[cd987456]

回答ありがとうございます。最初関数で処理しようかと思ったのですが、
前後の処理（プログラム）と合わせて考え、VBAで処理したいと思いました。
教えて頂いた関数参考にさせて頂きます。
ありがとうございました。