Excel VBA質問箱 IV

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

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


1511 / 13644 ツリー ←次へ | 前へ→

【73864】別シート検索してマッチすれば値を+1 nonoka 13/2/26(火) 11:09 質問[未読]
【73865】Re:別シート検索してマッチすれば値を+1 UO3 13/2/26(火) 12:36 発言[未読]
【73866】Re:別シート検索してマッチすれば値を+1 nonoka 13/2/26(火) 13:19 質問[未読]
【73867】Re:別シート検索してマッチすれば値を+1 nonoka 13/2/26(火) 15:54 質問[未読]
【73878】Re:別シート検索してマッチすれば値を+1 UO3 13/2/27(水) 10:41 発言[未読]
【73879】Re:別シート検索してマッチすれば値を+1 UO3 13/2/27(水) 16:30 発言[未読]
【73880】Re:別シート検索してマッチすれば値を+1 nonoka 13/2/27(水) 17:03 回答[未読]
【73894】Re:別シート検索してマッチすれば値を+1 nonoka 13/3/18(月) 15:49 回答[未読]
【73903】Re:別シート検索してマッチすれば値を+1 UO3 13/3/19(火) 5:44 発言[未読]
【73904】Re:別シート検索してマッチすれば値を+1 nonoka 13/3/19(火) 9:27 発言[未読]
【73905】Re:別シート検索してマッチすれば値を+1 UO3 13/3/19(火) 9:44 発言[未読]
【73906】Re:別シート検索してマッチすれば値を+1 UO3 13/3/19(火) 9:50 発言[未読]
【73907】Re:別シート検索してマッチすれば値を+1 nonoka 13/3/19(火) 9:59 回答[未読]
【73908】Re:別シート検索してマッチすれば値を+1 UO3 13/3/19(火) 10:50 発言[未読]
【73909】Re:別シート検索してマッチすれば値を+1 nonoka 13/3/19(火) 11:14 回答[未読]
【73910】Re:別シート検索してマッチすれば値を+1 UO3 13/3/19(火) 13:59 発言[未読]
【73916】Re:別シート検索してマッチすれば値を+1 nonoka 13/3/19(火) 19:10 質問[未読]
【73917】Re:別シート検索してマッチすれば値を+1 nonoka 13/3/19(火) 19:19 質問[未読]
【73918】Re:別シート検索してマッチすれば値を+1 nonoka 13/3/19(火) 19:37 お礼[未読]
【73911】Re:別シート検索してマッチすれば値を+1 UO3 13/3/19(火) 14:01 発言[未読]
【73912】Re:別シート検索してマッチすれば値を+1 UO3 13/3/19(火) 15:31 発言[未読]
【73915】Re:別シート検索してマッチすれば値を+1 nonoka 13/3/19(火) 18:29 回答[未読]

【73864】別シート検索してマッチすれば値を+1
質問  nonoka  - 13/2/26(火) 11:09 -

引用なし
パスワード
   いつもお世話になりありがとうございます。

VBNコードの途中にCallで下記コード入れました。

メインのコードで計算していて、計算の途中に下記処理を挟みたいと思っています。
そのなかで検索する値をどう設定していいのかわかりません。
これでは不可能というか考え方が間違っていますか?

下記コードはまだテスト段階で題名と不一致です。
検索する値を設定出来ればこれも設定可能かと思っています。
ご教授ください。宜しくお願い申し上げます。


Sub Search()
  Dim rngTarget  As Range
  Dim rngFind   As Range

  ' 検索する範囲
  Set rngTarget = Sheets("holiday").Columns("B4:S200")
  ' 検索
  Set rngFind = rngTarget.Find("検索する値")

  If rngFind Is Nothing Then
    MsgBox "既存データは存在しません。"
  Else
    MsgBox "既存データが存在します。"
  End If
End Sub

【73865】Re:別シート検索してマッチすれば値を+1
発言  UO3  - 13/2/26(火) 12:36 -

引用なし
パスワード
   ▼nonoka さん:

こんにちは

検索値を、別途計算(?)して取得した値にしたいということでしょうか?
であれば、たとえば、その計算で取得した値が kekka という名前の変数にはいっているとすれば

Set rngFind = rngTarget.Find(kekka)

でいいと思いますが。

それより、Findメソッドの引数の重要なものは、シート上の操作も含み、【前回の検索や置換】で
指定したオプション設定を引き継ぎます。

完全一致で検索したいのに、たまたま、そのシートで、直近に、部分一致の置換がなされていれば
部便一致の検索になります。

重要な引数はすべて明示的に指定しましょう。
詳しくはFindメソッドのヘルプを参照してください。

【73866】Re:別シート検索してマッチすれば値を+1
質問  nonoka  - 13/2/26(火) 13:19 -

引用なし
パスワード
   ▼UO3 さん:
早速のご返答感謝します。
自分でトライしてみましたが、やはり手におえないようです。
以前、U03様に計画調整のコードを作成して頂きました(下記)。
以前のコードは3つのキャパを計算しながら計画調整を行うコードでした。
それを下記のようにキャパ計算幅を増やしてコードを書き直しました。
単に指定するセルを増やしただけですので、シンプルではありませんが・・・。
これはこれで、完璧に作動します。

コード下部の”capacity超えの場合”のところに、
シートholidayのリストとマッチすれば+1日したいのですが、
それはK列ではなく、N〜AA列での作業となりますので
とりあえずN〜AA列の関数をVLOOKUPで参照しながらという形でやってみますが、
下記コードに追加は出来そうですか?


Private Sub 計画調整()
  Dim z As Long
  Dim c As Range
  Dim r1 As Range
  Dim r2 As Range
  Dim r3 As Range
  Dim r4 As Range
  Dim r5 As Range
  Dim r6 As Range
  Dim r7 As Range
  Dim r8 As Range
  Dim r9 As Range
  Dim r10 As Range
  Dim r11 As Range
  Dim r12 As Range
  Dim r13 As Range
  Dim r14 As Range
  Dim n1 As Long
  Dim n2 As Long
  Dim n3 As Long
  Dim n4 As Long
  Dim n5 As Long
  Dim n6 As Long
  Dim n7 As Long
  Dim n8 As Long
  Dim n9 As Long
  Dim n10 As Long
  Dim n11 As Long
  Dim n12 As Long
  Dim n13 As Long
  Dim n14 As Long
  Dim x1 As Long
  Dim x2 As Long
  Dim x3 As Long
  Dim x4 As Long
  Dim x5 As Long
  Dim x6 As Long
  Dim x7 As Long
  Dim x8 As Long
  Dim x9 As Long
  Dim x10 As Long
  Dim x11 As Long
  Dim x12 As Long
  Dim x13 As Long
  Dim x14 As Long
 

  Dim d As Date
  Dim col As Variant
 
  With Sheets("Schedule")
 
    z = .Range("C" & .Rows.Count).End(xlUp).Row - 9 'データ数
    Set r1 = .Range("N10").Resize(z)
    Set r2 = .Range("O10").Resize(z)
    Set r3 = .Range("P10").Resize(z)
    Set r4 = .Range("Q10").Resize(z)
    Set r5 = .Range("R10").Resize(z)
    Set r6 = .Range("S10").Resize(z)
    Set r7 = .Range("T10").Resize(z)
    Set r8 = .Range("U10").Resize(z)
    Set r9 = .Range("V10").Resize(z)
    Set r10 = .Range("W10").Resize(z)
    Set r11 = .Range("X10").Resize(z)
    Set r12 = .Range("Y10").Resize(z)
    Set r13 = .Range("Z10").Resize(z)
    Set r14 = .Range("AA10").Resize(z)
    
    n1 = .Range("N6").Value
    n2 = .Range("O6").Value
    n3 = .Range("P6").Value
    n4 = .Range("Q6").Value
    n5 = .Range("R6").Value
    n6 = .Range("S6").Value
    n7 = .Range("T6").Value
    n8 = .Range("U6").Value
    n9 = .Range("V6").Value
    n10 = .Range("W6").Value
    n11 = .Range("X6").Value
    n12 = .Range("Y6").Value
    n13 = .Range("Z6").Value
    n14 = .Range("AA6").Value
  
    For Each c In .Range("C10").Resize(z)
      With c.EntireRow
        If Len(.Range("K1").Value) = 0 Then    'K列未セットのものだけ
          .Range("K1").Value = c.Value      '入力日->開始日
          Do
            x1 = 0
            x2 = 0
            x3 = 0
            x4 = 0
            x5 = 0
            x6 = 0
            x7 = 0
            x8 = 0
            x9 = 0
            x10 = 0
            x11 = 0
            x12 = 0
            x13 = 0
            x14 = 0
            
            
            'capacity計算全項目
            
            If Len(.Range("N1").Value) > 0 Then x1 = WorksheetFunction.CountIf(r1, .Range("N1").Value)
            If Len(.Range("O1").Value) > 0 Then x2 = WorksheetFunction.CountIf(r2, .Range("O1").Value)
            If Len(.Range("P1").Value) > 0 Then x3 = WorksheetFunction.CountIf(r3, .Range("P1").Value)
            If Len(.Range("Q1").Value) > 0 Then x4 = WorksheetFunction.CountIf(r4, .Range("Q1").Value)
            If Len(.Range("R1").Value) > 0 Then x5 = WorksheetFunction.CountIf(r5, .Range("R1").Value)
            If Len(.Range("S1").Value) > 0 Then x6 = WorksheetFunction.CountIf(r6, .Range("S1").Value)
            If Len(.Range("T1").Value) > 0 Then x7 = WorksheetFunction.CountIf(r7, .Range("T1").Value)
            If Len(.Range("U1").Value) > 0 Then x8 = WorksheetFunction.CountIf(r8, .Range("U1").Value)
            If Len(.Range("V1").Value) > 0 Then x9 = WorksheetFunction.CountIf(r9, .Range("V1").Value)
            If Len(.Range("W1").Value) > 0 Then x10 = WorksheetFunction.CountIf(r10, .Range("W1").Value)
            If Len(.Range("X1").Value) > 0 Then x11 = WorksheetFunction.CountIf(r11, .Range("X1").Value)
            If Len(.Range("Y1").Value) > 0 Then x12 = WorksheetFunction.CountIf(r12, .Range("Y1").Value)
            If Len(.Range("Z1").Value) > 0 Then x13 = WorksheetFunction.CountIf(r13, .Range("Z1").Value)
            If Len(.Range("AA1").Value) > 0 Then x14 = WorksheetFunction.CountIf(r14, .Range("AA1").Value)
                     
           
            'capacity超えの場合開始日をプラス1日
                     
            If x1 <= n1 And x2 <= n2 And x3 <= n3 And x4 <= n4 And x5 <= n5 And x6 <= n6 And x7 <= n7 And x8 <= n8 And x9 <= n9 And x10 <= n10 And x11 <= n11 And x12 <= n12 And x13 <= n13 And x14 <= n14 Then Exit Do
            .Range("K1").Value = .Range("K1").Value + 1 '翌日


          Loop
        End If
      End With
    Next
  
  End With
 
End Sub

【73867】Re:別シート検索してマッチすれば値を+1
質問  nonoka  - 13/2/26(火) 15:54 -

引用なし
パスワード
   ▼UO3 さん:
関数で対応出来るかと思いましたが、ループが出来ない為、連休に対応できませんでした。

一からコード書き直した方が良いですか?
一応内容説明書きます。

シート名Schedule
データ開始行は10行目
AD〜AQに1か0の数字が入力されます。
N〜AAには現在関数が入っていてAD〜AQをそれぞれ読み込んで計算しています。
ADはNに対応、OはAEという感じです。

K列にはC列から読み取った日付を基準に日付が入力されていきます。
N〜AAにはそれぞれキャパが設定(N6〜AA6)
キャパを超えると+1日するというのが前回までのコードでした。

処理をよく見ているとNからAAまで行ごとに計算されています。
その中で各セルで計算が終わった段階で次のセルに行かずに、
シート名holidayのB4:S200のなかにある日付と一致するものがあれば1日プラスして
またholidayのデータと比べるを繰り返す。holidayのデータと一致しなければ、
次のセルでキャパ計算・・・。
といった感じです。相変わらず説明下手ですが、ご了承ください。

【73878】Re:別シート検索してマッチすれば値を+1
発言  UO3  - 13/2/27(水) 10:41 -

引用なし
パスワード
   ▼nonoka さん:

シートレイアウト含めて、すっかり忘れています。
今回アップされたコードから、逆にレイアウトをおこしていく手もありますが
前のトピも探しまくりながら(?)そうとう長いリハビリ期間が必要になると思います。

気長にお待ちください。

【73879】Re:別シート検索してマッチすれば値を+1
発言  UO3  - 13/2/27(水) 16:30 -

引用なし
パスワード
   ▼nonoka さん:

こんにちは

レイアウトは思いだしておりません。
また、コードも精査していません。
ただ、コードについてはおそらく、前回、私が提示したものに、項目を増やしただけだと思います。
あたるも八卦、あたらぬも八卦。

If x1 <= n1 And x2 <= n2 ・・・・・・And x14 <= n14 Then Exit Do

これを

If Sheets("holiday").Range("B4:S200").Find(What:=.Range("K1").Value, LookAt:=xlWhole) Is Nothing Then

  If x1 <= n1 And x2 <= n2 ・・・・・・And x14 <= n14 Then Exit Do

End If

こうかえてお試しください。

【73880】Re:別シート検索してマッチすれば値を+1
回答  nonoka  - 13/2/27(水) 17:03 -

引用なし
パスワード
   ▼UO3 さん:

試しました。途中で固まってしまいます。

K列基準日を入力するとN〜AAに日付が入りどこかの列でキャパオーバーすると
K列をプラス1日する形です。入っている関数にも問題があるように感じましたので、関数訂正するのでしばらくお待ちください。
案外関数の計算(N〜AA)が間違っているだけで、当たってるかもしれません。

【73894】Re:別シート検索してマッチすれば値を+1
回答  nonoka  - 13/3/18(月) 15:49 -

引用なし
パスワード
   ▼UO3 さん:
サイトに入れなかったので、自力で頑張りましたが力及びませんでした。
諦めかけていたのですが、やっと入れたのでお願い致します。

ご教授頂いたコードに訂正しました。
現在の状況ですが、
スタートの日、K列で休日が反映されてしまってます。
K列はキャパオーバーの際に翌日にするというのは今まで通りで結構です。
休日の際の検索対象はN;AAです。この中で休日と一致すれば次の営業日にする。
休日リストはシート名【holiday】の中のB4;S200です。

依頼してかなり日が経過していて忘れておられるとは思います。
今週中には仕上げたいと思っていますので、
じゃんじゃん質問ください。宜しくお願い申し上げます。

【73903】Re:別シート検索してマッチすれば値を+1
発言  UO3  - 13/3/19(火) 5:44 -

引用なし
パスワード
   ▼nonoka さん:

おはようございます
やっと復旧したようですね。
(これまでも、別ルート、昔のURLでログインはできていたのですが)

さて、指摘の件、ちょっと勘違いがありましたね。
私のコードの手当は、K列の日付のみを休日なら翌日に回すというものでした。

>休日の際の検索対象はN;AAです。この中で休日と一致すれば次の営業日にする。

実際には、このK列を基準に関数で導き出す、これらの列の日付を繰り越したかったんですね。

であれば、関数が入っているこれら列のセルを書き換えると、関数そのものが消えてしまいますので
具合が悪いですね。

コードを元に戻しましょう。
で、関数側で休日なら繰越という処理をしましょう。

関数は不得意ですが、N:AAにセットしてある関数、いくつかアップしてください。
そこを直してみましょう。

【73904】Re:別シート検索してマッチすれば値を+1
発言  nonoka  - 13/3/19(火) 9:27 -

引用なし
パスワード
   ▼UO3 さん:
おはようございます!
昨日、試行錯誤して素人ながら関数をなくして下記コードにしました。
中段のOG工程からINS工程でN〜AAに入力するようにしました。
関数をそのままコードにしただけです。動作確認済みです。
これで対応できますか?


Private Sub 計画調整()
  Dim z As Long
  Dim c As Range
  Dim r1 As Range
  Dim r2 As Range
  Dim r3 As Range
  Dim r4 As Range
  Dim r5 As Range
  Dim r6 As Range
  Dim r7 As Range
  Dim r8 As Range
  Dim r9 As Range
  Dim r10 As Range
  Dim r11 As Range
  Dim r12 As Range
  Dim r13 As Range
  Dim r14 As Range
  Dim n1 As Long
  Dim n2 As Long
  Dim n3 As Long
  Dim n4 As Long
  Dim n5 As Long
  Dim n6 As Long
  Dim n7 As Long
  Dim n8 As Long
  Dim n9 As Long
  Dim n10 As Long
  Dim n11 As Long
  Dim n12 As Long
  Dim n13 As Long
  Dim n14 As Long
  Dim x1 As Long
  Dim x2 As Long
  Dim x3 As Long
  Dim x4 As Long
  Dim x5 As Long
  Dim x6 As Long
  Dim x7 As Long
  Dim x8 As Long
  Dim x9 As Long
  Dim x10 As Long
  Dim x11 As Long
  Dim x12 As Long
  Dim x13 As Long
  Dim x14 As Long
 
 
  Dim d As Date
  Dim col As Variant
 
  With Sheets("Schedule")
 
    z = .Range("C" & .Rows.Count).End(xlUp).Row - 9 'データ数
    Set r1 = .Range("N10").Resize(z)
    Set r2 = .Range("O10").Resize(z)
    Set r3 = .Range("P10").Resize(z)
    Set r4 = .Range("Q10").Resize(z)
    Set r5 = .Range("R10").Resize(z)
    Set r6 = .Range("S10").Resize(z)
    Set r7 = .Range("T10").Resize(z)
    Set r8 = .Range("U10").Resize(z)
    Set r9 = .Range("V10").Resize(z)
    Set r10 = .Range("W10").Resize(z)
    Set r11 = .Range("X10").Resize(z)
    Set r12 = .Range("Y10").Resize(z)
    Set r13 = .Range("Z10").Resize(z)
    Set r14 = .Range("AA10").Resize(z)
    
    n1 = .Range("N6").Value
    n2 = .Range("O6").Value
    n3 = .Range("P6").Value
    n4 = .Range("Q6").Value
    n5 = .Range("R6").Value
    n6 = .Range("S6").Value
    n7 = .Range("T6").Value
    n8 = .Range("U6").Value
    n9 = .Range("V6").Value
    n10 = .Range("W6").Value
    n11 = .Range("X6").Value
    n12 = .Range("Y6").Value
    n13 = .Range("Z6").Value
    n14 = .Range("AA6").Value
  
    For Each c In .Range("C10").Resize(z)
      With c.EntireRow
        If Len(.Range("K1").Value) = 0 Then   'K列未セットのものだけ
          .Range("K1").Value = c.Value '入力日->開始日
          Do
            x1 = 0
            x2 = 0
            x3 = 0
            x4 = 0
            x5 = 0
            x6 = 0
            x7 = 0
            x8 = 0
            x9 = 0
            x10 = 0
            x11 = 0
            x12 = 0
            x13 = 0
            x14 = 0
            
            s1 = .Range("AD1").Value
            s2 = .Range("AE1").Value
            s3 = .Range("AF1").Value
            s4 = .Range("AG1").Value
            s5 = .Range("AH1").Value
            s6 = .Range("AI1").Value
            s7 = .Range("AJ1").Value
            s8 = .Range("AK1").Value
            s9 = .Range("AL1").Value
            s10 = .Range("AM1").Value
            s11 = .Range("AN1").Value
            s12 = .Range("AO1").Value
            s13 = .Range("AP1").Value
            s14 = .Range("AQ1").Value
          
          'OG工程
            If Val(s1) = 1 Then
            .Range("N1").Value = .Range("K1").Value + Val(s1)
            Else
            .Range("N1").ClearContents
            End If
            
          'RX工程
            If Val(s2) = 1 Then
            .Range("O1").Value = .Range("N1").Value + Val(s2)
            Else
            .Range("O1").ClearContents
             End If
            
          'PS工程
            If Val(s3) = 1 Then
            .Range("P1").Value = .Range("O1").Value + Val(s3)
            ElseIf Val(s3) = 0 Then
            .Range("P1").ClearContents
            Else
            .Range("P1").Value = .Range("N1").Value + Val(s4)
            End If
            
          'DYE-D工程
            If Val(s4) = 0 Then
            .Range("Q1").ClearContents
            ElseIf Val(s3) = 0 Then
            .Range("Q1").Value = .Range("N1").Value + Val(s4)
            Else
            .Range("Q1").Value = .Range("P1").Value + Val(s4)
            End If
            
           'DYE-L工程
            If Val(s5) = 0 Then
            .Range("R1").ClearContents
            ElseIf Val(s3) = 0 Then
            .Range("R1").Value = .Range("N1").Value + Val(s5)
            Else
            .Range("R1").Value = .Range("P1").Value + Val(s5)
            End If
          
           'MS工程
            If Val(s6) = 0 Then
            .Range("S1").ClearContents
            ElseIf Val(s5) = 1 Then
            .Range("S1").Value = .Range("R1").Value + Val(s6)
            Else
            .Range("S1").Value = .Range("Q1").Value + Val(s6)
            End If
            
           'RC工程
            If Val(s7) = 0 Then
            .Range("T1").ClearContents
            Else
            .Range("T1").Value = .Range("S1").Value + Val(s7)
            End If
            
           'DRY工程
            If Val(s8) = 0 Then
            .Range("U1").ClearContents
            Else
            .Range("U1").Value = .Range("T1").Value + Val(s8)
            End If
            
           'FS工程
            If Val(s9) = 0 Then
            .Range("V1").ClearContents
            ElseIf Val(s8) = 1 Then
            .Range("V1").Value = .Range("U1").Value + Val(s9)
            Else
              If Val(s7) = 1 Then
              .Range("V1").Value = .Range("T1").Value + Val(s9)
              ElseIf Val(s5) = 0 Then
              .Range("V1").Value = .Range("Q1").Value + Val(s9)
              Else
              .Range("V1").Value = .Range("R1").Value + Val(s9)
              End If
            End If
            
           'INS工程
            .Range("W1").Value = .Range("V1").Value + Val(s10)
            .Range("X1").Value = .Range("W1").Value + Val(s11)
            .Range("Y1").Value = .Range("X1").Value + Val(s12)
            .Range("Z1").Value = .Range("Y1").Value + Val(s13)
            .Range("AA1").Value = .Range("Z1").Value + Val(s14)
            
            
            If Len(.Range("N1").Value) > 0 Then x1 = WorksheetFunction.CountIf(r1, .Range("N1").Value)
            If Len(.Range("O1").Value) > 0 Then x2 = WorksheetFunction.CountIf(r2, .Range("O1").Value)
            If Len(.Range("P1").Value) > 0 Then x3 = WorksheetFunction.CountIf(r3, .Range("P1").Value)
            If Len(.Range("Q1").Value) > 0 Then x4 = WorksheetFunction.CountIf(r4, .Range("Q1").Value)
            If Len(.Range("R1").Value) > 0 Then x5 = WorksheetFunction.CountIf(r5, .Range("R1").Value)
            If Len(.Range("S1").Value) > 0 Then x6 = WorksheetFunction.CountIf(r6, .Range("S1").Value)
            If Len(.Range("T1").Value) > 0 Then x7 = WorksheetFunction.CountIf(r7, .Range("T1").Value)
            If Len(.Range("U1").Value) > 0 Then x8 = WorksheetFunction.CountIf(r8, .Range("U1").Value)
            If Len(.Range("V1").Value) > 0 Then x9 = WorksheetFunction.CountIf(r9, .Range("V1").Value)
            If Len(.Range("W1").Value) > 0 Then x10 = WorksheetFunction.CountIf(r10, .Range("W1").Value)
            If Len(.Range("X1").Value) > 0 Then x11 = WorksheetFunction.CountIf(r11, .Range("X1").Value)
            If Len(.Range("Y1").Value) > 0 Then x12 = WorksheetFunction.CountIf(r12, .Range("Y1").Value)
            If Len(.Range("Z1").Value) > 0 Then x13 = WorksheetFunction.CountIf(r13, .Range("Z1").Value)
            If Len(.Range("AA1").Value) > 0 Then x14 = WorksheetFunction.CountIf(r14, .Range("AA1").Value)
            
            If x1 <= n1 And x2 <= n2 And x3 <= n3 And x4 <= n4 And x5 <= n5 And x6 <= n6 And x7 <= n7 And x8 <= n8 And x9 <= n9 And x10 <= n10 And x11 <= n11 And x12 <= n12 And x13 <= n13 And x14 <= n14 Then Exit Do
            .Range("K1").Value = .Range("K1").Value + 1 '翌日
            
          
          Loop
        End If
      End With
    Next
  
  End With
 

End Sub

【73905】Re:別シート検索してマッチすれば値を+1
発言  UO3  - 13/3/19(火) 9:44 -

引用なし
パスワード
   ▼nonoka さん:

おはようございます

まず、↑で、コードは元に戻しましょうと申し上げましたが、
もしK列自体も休日なら翌日にしておく必要があれば元に戻さず、
連絡した対処でお願いします。

で、N;AA の日付については、申し上げた通り、関数側で対処が必要です。
この対処を、今のところ以下のように考えています。

たとえば各セルに

=IF(K10="","",IF(AG10=0,"",$K10+AD10+AE10+AF10+AG10))
=IF(K10="","",IF(AH10=0,"",$K10+AD10+AE10+AF10+AG10+AH10))
=IF(K10="","",IF(AL10=0,"",$K10+AD10+AE10+AF10+AG10+AH10+AI10+AJ10+AK10+AL10))

こんなようになっているとします。
これを、VBA側で、たとえばGetWorkDate といったユーザー定義関数を準備して、

=GetWorkDate(K10,AD19,AE10,AF10,AG10) というように書き直します。
この機能は
K10 が空白なら空白
K10に値がある場合は、列挙された最後のセル(この場合はAG10)が空白なら空白。
そうでない場合は、列挙されたものを合計。
こういったものを考えています。

このGetWOrkDateの中で、現在K列で行っているような休日チェックを行います。
ちょっと気になっているのは、現在、この処理を、VBAの中でも、負荷の大きな
Findメソッドを使っている点です。1つ、2つならどうってことはないのですが、
おそらく膨大な数のセルに式が配置されていると思いますので、ここを少しでも
軽くできるかどうかがポイント。
土日も翌日回しということなら、ロジックの中で シート関数のNETWORKDAYS等も
使えるかな?と思っているのですが、いやいや、そうではない、あくまで休日リスト
の日付だけを翌日回しということなら、Findを使わざるを得ないかも。

また、休日リストが、現在のように B4:S200 ではなく 1列にずらっとセット
してあれば、Findより、やや軽めのMATCH関数が使えます。

そこはいかがでしょう?

【73906】Re:別シート検索してマッチすれば値を+1
発言  UO3  - 13/3/19(火) 9:50 -

引用なし
パスワード
   ▼nonoka さん:

いきちがいになったようですね。
関数をやめてVBA処理にすること自体は賛成です。
ですから、そちらで対処されたコードを今から読んで
そこに、わたしが↑で申し上げた GetWorkDate のような
共通プロシジャをかませましょう。
しばらくお待ちください。

ただ、↑で質問している、土日の件と旧じぃつリストのフォーマットを
1列にできるかどうかについてはお答えください。

【73907】Re:別シート検索してマッチすれば値を+1
回答  nonoka  - 13/3/19(火) 9:59 -

引用なし
パスワード
   ▼UO3 さん:
下記に返信します。

>まず、↑で、コードは元に戻しましょうと申し上げましたが、
>もしK列自体も休日なら翌日にしておく必要があれば元に戻さず、
>連絡した対処でお願いします。

K列は入力日ですので、休日の計算は不要です。

>=GetWorkDate(K10,AD19,AE10,AF10,AG10) というように書き直します。
>この機能は
>K10 が空白なら空白
>K10に値がある場合は、列挙された最後のセル(この場合はAG10)が空白なら空白。
>そうでない場合は、列挙されたものを合計。
>こういったものを考えています。

これはセルの関数をコードに変えるということですよね?
今IFで作ったコードではおっしゃるとおりかなり重いです。
この処理で軽くなるということですよね?

>
>このGetWOrkDateの中で、現在K列で行っているような休日チェックを行います。
>ちょっと気になっているのは、現在、この処理を、VBAの中でも、負荷の大きな
>Findメソッドを使っている点です。1つ、2つならどうってことはないのですが、
>おそらく膨大な数のセルに式が配置されていると思いますので、ここを少しでも
>軽くできるかどうかがポイント。
>土日も翌日回しということなら、ロジックの中で シート関数のNETWORKDAYS等も
>使えるかな?と思っているのですが、いやいや、そうではない、あくまで休日リスト
>の日付だけを翌日回しということなら、Findを使わざるを得ないかも。
>
>また、休日リストが、現在のように B4:S200 ではなく 1列にずらっとセット
>してあれば、Findより、やや軽めのMATCH関数が使えます。
>

あくまで休日リストでB4から下に一列は可能です。

【73908】Re:別シート検索してマッチすれば値を+1
発言  UO3  - 13/3/19(火) 10:50 -

引用なし
パスワード
   ▼nonoka さん:

>K列は入力日ですので、休日の計算は不要です。

了解です。

考えています。

>これはセルの関数をコードに変えるということですよね?
>今IFで作ったコードではおっしゃるとおりかなり重いです。
>この処理で軽くなるということですよね?

関数継続ならということで提案しました。
申し上げたように、関数をやめてVBAで処理するのは大賛成です。
ユーザー定義関数にしても、重いのはかわりませんので。

>あくまで休日リストでB4から下に一列は可能です。

了解です。

★ということで、今から、コード対応着手します。
 少し時間ください。今週中というターゲットは大丈夫だと思います。

【73909】Re:別シート検索してマッチすれば値を+1
回答  nonoka  - 13/3/19(火) 11:14 -

引用なし
パスワード
   ▼UO3 さん:
助かります。いつもお手数をお掛けして申し訳ありません。
宜しくお願い致します!

【73910】Re:別シート検索してマッチすれば値を+1
発言  UO3  - 13/3/19(火) 13:59 -

引用なし
パスワード
   ▼nonoka さん:

こんにちは

アップされたコード、各種変数がそれぞれ14、そこへの値のセットも14行、処理も14・・
というところが気になりましたので、変数を配列にして、変数定義も1行、値のセットも1行
処理もループでコンパクトに・・・・

ということでコードを書き始めたんですが、考え直しました。
コードはコンパクトになったとしても、そのためのバグつぶしに時間がかかるかもしれませんし
今後の、そちらでの運用過程で追加改訂なども考えられ、その時に、nonokaさんが理解して
コード対応を行わなければいけないですよね。

なので、とりあえず・・・というか・・・最終的に。

以下のプロシジャを追加してください。

Function GetWorkDate(ByVal dt As Date) As Date
  Dim a As Variant
  With Sheets("holiday")
    Do
      a = Application.Match(CDbl(dt), .Range("B4", .Range("B" & .Rows.Count).End(xlUp)), 0)
      If Not IsNumeric(a) Then Exit Do
      dt = dt + 1
    Loop
  End With
  GetWorkDate = dt
End Function

で、現在、N列〜AA列に日付をセットしておられるところ、たとえば

.Range("N1").Value = .Range("K1").Value + Val(s(1))

ここを

.Range("N1").Value = GetWorkDate(.Range("K1").Value + Val(s(1)))

こんなふうに変更してみてください。
セットしようとしている日付が休日リストにあった場合、翌日、翌々日。。。と
一番近い営業日にかえてセットします。

【73911】Re:別シート検索してマッチすれば値を+1
発言  UO3  - 13/3/19(火) 14:01 -

引用なし
パスワード
   ▼nonoka さん:

追伸です。
休日リストは、B4から下に1列というコードにしてあります。

【73912】Re:別シート検索してマッチすれば値を+1
発言  UO3  - 13/3/19(火) 15:31 -

引用なし
パスワード
   ▼nonoka さん:

老婆心ながら・・・

PS工程の

.Range("P1").Value = .Range("N1").Value + Val(s4)

ここは s4 でいいのですか? s3 ではなく?

【73915】Re:別シート検索してマッチすれば値を+1
回答  nonoka  - 13/3/19(火) 18:29 -

引用なし
パスワード
   ▼UO3 さん:

ご指摘通りS3です。ありがとうございます。
今から検証します。

>
>老婆心ながら・・・
>
>PS工程の
>
>.Range("P1").Value = .Range("N1").Value + Val(s4)
>
>ここは s4 でいいのですか? s3 ではなく?

【73916】Re:別シート検索してマッチすれば値を+1
質問  nonoka  - 13/3/19(火) 19:10 -

引用なし
パスワード
   ▼UO3 さん:

すいません。確認です。
どこに追加すればよろしいでしょうか?


>
>こんにちは
>
>アップされたコード、各種変数がそれぞれ14、そこへの値のセットも14行、処理も14・・
>というところが気になりましたので、変数を配列にして、変数定義も1行、値のセットも1行
>処理もループでコンパクトに・・・・
>
>ということでコードを書き始めたんですが、考え直しました。
>コードはコンパクトになったとしても、そのためのバグつぶしに時間がかかるかもしれませんし
>今後の、そちらでの運用過程で追加改訂なども考えられ、その時に、nonokaさんが理解して
>コード対応を行わなければいけないですよね。
>
>なので、とりあえず・・・というか・・・最終的に。
>
>以下のプロシジャを追加してください。
>
>Function GetWorkDate(ByVal dt As Date) As Date
>  Dim a As Variant
>  With Sheets("holiday")
>    Do
>      a = Application.Match(CDbl(dt), .Range("B4", .Range("B" & .Rows.Count).End(xlUp)), 0)
>      If Not IsNumeric(a) Then Exit Do
>      dt = dt + 1
>    Loop
>  End With
>  GetWorkDate = dt
>End Function
>
>で、現在、N列〜AA列に日付をセットしておられるところ、たとえば
>
> .Range("N1").Value = .Range("K1").Value + Val(s(1))
>
>ここを
>
> .Range("N1").Value = GetWorkDate(.Range("K1").Value + Val(s(1)))
>
>こんなふうに変更してみてください。
>セットしようとしている日付が休日リストにあった場合、翌日、翌々日。。。と
>一番近い営業日にかえてセットします。

【73917】Re:別シート検索してマッチすれば値を+1
質問  nonoka  - 13/3/19(火) 19:19 -

引用なし
パスワード
   ▼UO3 さん:

下記試しましたが、コンパイルエラーがでます。
subまたはfunctionが定義されていません。と出ます。


>
>で、現在、N列〜AA列に日付をセットしておられるところ、たとえば
>
> .Range("N1").Value = .Range("K1").Value + Val(s(1))
>
>ここを
>
> .Range("N1").Value = GetWorkDate(.Range("K1").Value + Val(s(1)))
>
>こんなふうに変更してみてください。
>セットしようとしている日付が休日リストにあった場合、翌日、翌々日。。。と
>一番近い営業日にかえてセットします。

【73918】Re:別シート検索してマッチすれば値を+1
お礼  nonoka  - 13/3/19(火) 19:37 -

引用なし
パスワード
   ▼UO3 さん:
すいません。出来ました!
休日も飛ばすことが出来ました。

functionプロシージャの使い方がわかりませんでした。
追記する形でよかったんですね・・・。

ありがとうございました!
これで、ようやく形になりました。
UO3様様です。本当にありがとうございました。

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