[[20060817161236]]　『VBAに変換』（Nori）　ページの最後に飛ぶ

『VBAに変換』（Nori）

 こんにちは。ご無沙汰しております。
 今回も、ご教授をお願いします。
 N16=IF(CEILING(Sheet1!O16,100)=0,0,IF(Sheet1!O16-Sheet1!N16<0,0,CEILING(Sheet1!O16-Sheet1!N16,100)))
 １.N16:N834にフィルドラッグして使用している。
 ２.１行おきに数式を入力してある。
 ３.N16:N834には行の追加が発生する。

 今↑のIF関数とCEILING関数を使用して、計算をしているのですが、データ量が多く、
 再計算に時間が掛かってしまいます。
 なので、数式をVBAに変換したいと思うのですが、いかんせん勉強不足でコードに変換する事が出来ません。
 どうか、救いの手をお願いします。
 (Nori)

 こんちは。
 まず確認ですが、
 N16=IF(OR(Sheet1!O16=0,Sheet1!O16<Sheet1!N16),0,CEILING(Sheet1!O16-Sheet1!N16,100))
 でも同じ結果を返すと思いますがいかがですか？
 CEILING(Sheet1!O16,100)=0
 がTRUEになるのは、Sheet1!O16=0 のときしかないと思います。
 (ROUGE)

 ご指摘の通りです。実際に確認してみた所、どちらも同様の結果が出ました。
 >CEILING(Sheet1!O16,100)=0
 >がTRUEになるのは、Sheet1!O16=0 のときしかないと思います。
 0では0にしかならないので、Sheet1!O16=0でも同じ事ですね。
 もう少し、考えなくてはいけないですね…
 (Nori)

 ちなみにこれでできますか？
 (ROUGE)
'----
Sub Sample()
    Dim tbl1, tbl2, ans, i As Long                  'tbl1,tbl2,ansをVariant型、iをLong型で変数の宣言
    tbl1 = Worksheets("Sheet1").Range("N16:O834")   'Sheet1のN16:O834を配列としてtbl1に取り込み
    tbl2 = Worksheets("Sheet2").Range("N16:N834")   'Sheet2のN16:N834を配列としてtbl2に取り込み
    ReDim ans(1 To UBound(tbl1, 1), 1 To 1)         '変数ansの配列の大きさを確定（ans(1 to 819,1 to 1)としてもOK）
    For i = 1 To UBound(tbl1, 1)                    'ループ開始。（for i=1 to 819 としてもOK）
        Select Case i Mod 2                         '変数iが奇数（偶数行）か偶数（奇数行）かを判断
            Case 0                                  'iが偶数（奇数行）の場合
                ans(i, 1) = tbl2(i, 1)              'ansにtbl2の数値を入れる
            Case 1                                  'iが奇数（偶数行）の場合
                If tbl1(i, 2) > 0 And tbl1(i, 2) > tbl1(i, 1) Then
                                                    'もしSheet1のO列が0以上でかつO列がN列より大きい場合
                    ans(i, 1) = WorksheetFunction.Ceiling(tbl1(i, 2) - tbl1(i, 1), 100)
                                                    'Ceiling（Noriさんが入力している数式）したものをansに入れる
                Else                                'そうでない場合、
                    ans(i, 1) = 0                   'ansに0を入れる。
                End If                              'もしは終わり。
        End Select                                  '偶数奇数の判断終わり。
    Next                                            'ループ
    Worksheets("Sheet2").Range("N16:N834").Value = ans    '<--Sheet2でよかったでしょうか？
                                                    'ループが終わったら、Sheet2のN16:N834にansを入れる。
    Erase tbl1, tbl2, ans                           'tbl1,tbl2,ansのお役御免
End Sub                                             'おしまい。

 ROUGEさん、↑のコードでバッチリでした。
 ですが、数式の答えが、Sheet2のN16:N834まで、出てしまっています。
 これを１行おきに計算をするように出来るでしょうか？
 もしくはSheet1のI列に文字列が入力されている行のみ計算をするという事は出来ますでしょうか？
 (Nori)

 １行おきでしたね。
 コードを書き換えました。
 (ROUGE)

 ROUGEさん、いえROUGE先生と呼ばせて下さい。
 完璧でございます。
 ありがとうございます。
 もしよろしければ、今後の為にコードの意味を教えて頂く事は出来るでしょうか？
 (Nori)

 説明つけました～
 それから、先生はやめてくらはい。
 σ(^-^;)はまだ^10です。。。
 (ROUGE)

 ROUGEさん、ありがとうございます。
 説明を見て、勉強したいと思います。
 それと、申し訳ないですが、もう１点教えて下さい。
 今のコードですと、N16:N834までを実行するようになっていますが、
 これを、I列に文字が入力されている行まで実行するようには出来るでしょうか？
 なぜかというと、最終行のN834が増える事があるからです。
 初めに説明しておけば良かったのですが、お手間を取らせてしまいすいません。
 (Nori)

 こんな感じです。
 (ROUGE)
'----
Sub Sample()
    Dim tbl1, tbl2, ans, i As Long, lr As Long
    lr = Worksheets("Sheet1").Range("I" & Rows.Count).End(xlUp).Row
    tbl1 = Worksheets("Sheet1").Range("N16:O" & lr)
    tbl2 = Worksheets("Sheet2").Range("N16:N" & lr)
    ReDim ans(1 To UBound(tbl1, 1), 1 To 1)
    For i = 1 To UBound(tbl1, 1)
        Select Case i Mod 2
            Case 0
                ans(i, 1) = tbl2(i, 1)
            Case 1
                If tbl1(i, 2) > 0 And tbl1(i, 2) > tbl1(i, 1) Then
                    ans(i, 1) = WorksheetFunction.Ceiling(tbl1(i, 2) - tbl1(i, 1), 100)
                Else
                    ans(i, 1) = 0
                End If
        End Select
    Next
    Worksheets("Sheet2").Range("N16").Resize(UBound(ans, 1)).Value = ans
    Erase tbl1, tbl2, ans
End Sub

 ROUGEさん、ありがとうございます。
 バッチシでございまつ。
 I列の最終行の選択方法をセルに入力されている最後の行までにしたのですね。
 また、分からない事が出てきましたら、ご教授をお願いします。
 (Nori)

 おはようございます。
 朝早くからすいません。早速、分からない事が出てきてしまいました。
 昨日、いろいろと検証してみたのですが、どうしても分かりませんでした。
 今、Sheet2のO16に下記の式を入力してあります。
 O16=IF(OR(Sheet1!P16=0,N16-Sheet1!O16>=Sheet1!P16),0,CEILING(Sheet1!P16-(N16-Sheet1!O16),100))
 この式を昨日ご教授を頂いた式に追記しようとしたのですが、どこに何を追記すればよいのか、分かりませんでした。
 お手数ですが、今一度ご教授をお願いします。
 (Nori)

 これでどうですか？（未検証）
 (ROUGE)
'----
Sub Sample()
    Dim tbl1, tbl2, ans, i As Long, lr As Long
    lr = Worksheets("Sheet1").Range("I" & Rows.Count).End(xlUp).Row
    tbl1 = Worksheets("Sheet1").Range("N16:P" & lr)
    tbl2 = Worksheets("Sheet2").Range("N16:O" & lr)
    ReDim ans(1 To UBound(tbl1, 1), 1 To 2)
    For i = 1 To UBound(tbl1, 1)
        Select Case i Mod 2
            Case 0
                ans(i, 1) = tbl2(i, 1)
                ans(i, 2) = tbl2(i, 2)
            Case 1
                If tbl1(i, 2) > 0 And tbl1(i, 2) > tbl1(i, 1) Then
                    ans(i, 1) = WorksheetFunction.Ceiling(tbl1(i, 2) - tbl1(i, 1), 100)
                Else
                    ans(i, 1) = 0
                End If
                If tbl1(i, 3) = 0 Or ans(i, 1) - tbl1(i, 2) >= tbl1(i, 3) Then
                    ans(i, 2) = 0
                Else
                    ans(i, 2) = WorksheetFunction.Ceiling(tbl1(i, 3) - (ans(i, 1) - tbl1(i, 2)), 100)
                End If
        End Select
    Next
    Worksheets("Sheet2").Range("N16").Resize(UBound(ans, 1), 2).Value = ans
    Erase tbl1, tbl2, ans
End Sub

 ROUGEさん、ありがとうございます。
 ですが、エラー等は特に出ていないのですが、追加してもらった数式の計算がされていません。
 (Nori)

 大きな間違いをしていました。
 修正しましたが、どうでしょうか？
 (ROUGE)

 ROUGEさん、おはようございます。
 修正して頂いたコード、バッチリでした。
 ありがとうございます。
 お忙しい所をお付き合いして頂き、ありがとうございました。
 また、何かありましたら、その時は、お願いします。
 (Nori)

コメント返信：

[ 一覧(最新更新順) ]

[[20060817161236]] 『VBAに変換』（Nori） ページの最後に飛ぶ

[[20060817161236]]　『VBAに変換』（Nori）　ページの最後に飛ぶ