Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1511 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【73864】別シート検索してマッチすれば値を＋１ nonoka 13/2/26(火) 11:09 質問[未読]
【73865】Re:別シート検索してマッチすれば値を＋１ UO3 13/2/26(火) 12:36 発言[未読]
【73866】Re:別シート検索してマッチすれば値を＋１ nonoka 13/2/26(火) 13:19 質問[未読]
【73867】Re:別シート検索してマッチすれば値を＋１ nonoka 13/2/26(火) 15:54 質問[未読]
【73878】Re:別シート検索してマッチすれば値を＋１ UO3 13/2/27(水) 10:41 発言[未読]
【73879】Re:別シート検索してマッチすれば値を＋１ UO3 13/2/27(水) 16:30 発言[未読]
【73880】Re:別シート検索してマッチすれば値を＋１ nonoka 13/2/27(水) 17:03 回答[未読]
【73894】Re:別シート検索してマッチすれば値を＋１ nonoka 13/3/18(月) 15:49 回答[未読]
【73903】Re:別シート検索してマッチすれば値を＋１ UO3 13/3/19(火) 5:44 発言[未読]
【73904】Re:別シート検索してマッチすれば値を＋１ nonoka 13/3/19(火) 9:27 発言[未読]
【73905】Re:別シート検索してマッチすれば値を＋１ UO3 13/3/19(火) 9:44 発言[未読]
【73906】Re:別シート検索してマッチすれば値を＋１ UO3 13/3/19(火) 9:50 発言[未読]
【73907】Re:別シート検索してマッチすれば値を＋１ nonoka 13/3/19(火) 9:59 回答[未読]
【73908】Re:別シート検索してマッチすれば値を＋１ UO3 13/3/19(火) 10:50 発言[未読]
【73909】Re:別シート検索してマッチすれば値を＋１ nonoka 13/3/19(火) 11:14 回答[未読]
【73910】Re:別シート検索してマッチすれば値を＋１ UO3 13/3/19(火) 13:59 発言[未読]
【73916】Re:別シート検索してマッチすれば値を＋１ nonoka 13/3/19(火) 19:10 質問[未読]
【73917】Re:別シート検索してマッチすれば値を＋１ nonoka 13/3/19(火) 19:19 質問[未読]
【73918】Re:別シート検索してマッチすれば値を＋１ nonoka 13/3/19(火) 19:37 お礼[未読]
【73911】Re:別シート検索してマッチすれば値を＋１ UO3 13/3/19(火) 14:01 発言[未読]
【73912】Re:別シート検索してマッチすれば値を＋１ UO3 13/3/19(火) 15:31 発言[未読]
【73915】Re:別シート検索してマッチすれば値を＋１ nonoka 13/3/19(火) 18:29 回答[未読]
【73864】別シート検索してマッチすれば値を＋１
質問  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:別シート検索してマッチすれば値を＋１
発言  UO3  - 13/2/26(火) 12:36 -
引用なし
パスワード
   ▼nonoka さん：

こんにちは

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

Set rngFind = rngTarget.Find(kekka)

でいいと思いますが。

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

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

重要な引数はすべて明示的に指定しましょう。
詳しくはFindメソッドのヘルプを参照してください。
【73866】Re:別シート検索してマッチすれば値を＋１
質問  nonoka  - 13/2/26(火) 13:19 -
引用なし
パスワード
   ▼UO3 さん：
早速のご返答感謝します。
自分でトライしてみましたが、やはり手におえないようです。
以前、U03様に計画調整のコードを作成して頂きました（下記）。
以前のコードは３つのキャパを計算しながら計画調整を行うコードでした。
それを下記のようにキャパ計算幅を増やしてコードを書き直しました。
単に指定するセルを増やしただけですので、シンプルではありませんが・・・。
これはこれで、完璧に作動します。

コード下部の”capacity超えの場合”のところに、
シートholidayのリストとマッチすれば＋１日したいのですが、
それはＫ列ではなく、Ｎ〜ＡＡ列での作業となりますので
とりあえずＮ〜ＡＡ列の関数を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超えの場合開始日をプラス１日
　　　　　　　　　　　　　　　　　　　　　
　　　　　　　　　　　　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:別シート検索してマッチすれば値を＋１
質問  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:別シート検索してマッチすれば値を＋１
発言  UO3  - 13/2/27(水) 10:41 -
引用なし
パスワード
   ▼nonoka さん：

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

気長にお待ちください。
【73879】Re:別シート検索してマッチすれば値を＋１
発言  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:別シート検索してマッチすれば値を＋１
回答  nonoka  - 13/2/27(水) 17:03 -
引用なし
パスワード
   ▼UO3 さん：

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

K列基準日を入力するとN〜AAに日付が入りどこかの列でキャパオーバーすると
K列をプラス1日する形です。入っている関数にも問題があるように感じましたので、関数訂正するのでしばらくお待ちください。
案外関数の計算（N〜AA）が間違っているだけで、当たってるかもしれません。
【73894】Re:別シート検索してマッチすれば値を＋１
回答  nonoka  - 13/3/18(月) 15:49 -
引用なし
パスワード
   ▼UO3 さん：
サイトに入れなかったので、自力で頑張りましたが力及びませんでした。
諦めかけていたのですが、やっと入れたのでお願い致します。

ご教授頂いたｺｰﾄﾞに訂正しました。
現在の状況ですが、
スタートの日、Ｋ列で休日が反映されてしまってます。
Ｋ列はキャパオーバーの際に翌日にするというのは今まで通りで結構です。
休日の際の検索対象はＮ；ＡＡです。この中で休日と一致すれば次の営業日にする。
休日リストはｼｰﾄ名【holiday】の中のＢ４；Ｓ２００です。

依頼してかなり日が経過していて忘れておられるとは思います。
今週中には仕上げたいと思っていますので、
じゃんじゃん質問ください。宜しくお願い申し上げます。
【73903】Re:別シート検索してマッチすれば値を＋１
発言  UO3  - 13/3/19(火) 5:44 -
引用なし
パスワード
   ▼nonoka さん：

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

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

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

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

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

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

関数は不得意ですが、Ｎ：ＡＡにセットしてある関数、いくつかアップしてください。
そこを直してみましょう。
【73904】Re:別シート検索してマッチすれば値を＋１
発言  nonoka  - 13/3/19(火) 9:27 -
引用なし
パスワード
   ▼UO3 さん：
おはようございます！
昨日、試行錯誤して素人ながら関数をなくして下記コードにしました。
中段のＯＧ工程からＩＮＳ工程でＮ〜ＡＡに入力するようにしました。
関数をそのままコードにしただけです。動作確認済みです。
これで対応できますか？


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:別シート検索してマッチすれば値を＋１
発言  UO3  - 13/3/19(火) 9:44 -
引用なし
パスワード
   ▼nonoka さん：

おはようございます

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

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

たとえば各セルに

=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))

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

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

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

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

そこはいかがでしょう？
【73906】Re:別シート検索してマッチすれば値を＋１
発言  UO3  - 13/3/19(火) 9:50 -
引用なし
パスワード
   ▼nonoka さん：

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

ただ、↑で質問している、土日の件と旧じぃつリストのフォーマットを
１列にできるかどうかについてはお答えください。
【73907】Re:別シート検索してマッチすれば値を＋１
回答  nonoka  - 13/3/19(火) 9:59 -
引用なし
パスワード
   ▼UO3 さん：
下記に返信します。

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

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

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

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

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

あくまで休日リストでB4から下に一列は可能です。
【73908】Re:別シート検索してマッチすれば値を＋１
発言  UO3  - 13/3/19(火) 10:50 -
引用なし
パスワード
   ▼nonoka さん：

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

了解です。

考えています。

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

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

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

了解です。

★ということで、今から、コード対応着手します。
　少し時間ください。今週中というターゲットは大丈夫だと思います。
【73909】Re:別シート検索してマッチすれば値を＋１
回答  nonoka  - 13/3/19(火) 11:14 -
引用なし
パスワード
   ▼UO3 さん：
助かります。いつもお手数をお掛けして申し訳ありません。
宜しくお願い致します！
【73910】Re:別シート検索してマッチすれば値を＋１
発言  UO3  - 13/3/19(火) 13:59 -
引用なし
パスワード
   ▼nonoka さん：

こんにちは

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

ということでコードを書き始めたんですが、考え直しました。
コードはコンパクトになったとしても、そのためのバグつぶしに時間がかかるかもしれませんし
今後の、そちらでの運用過程で追加改訂なども考えられ、その時に、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

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

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

ここを

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

こんなふうに変更してみてください。
セットしようとしている日付が休日リストにあった場合、翌日、翌々日。。。と
一番近い営業日にかえてセットします。
【73911】Re:別シート検索してマッチすれば値を＋１
発言  UO3  - 13/3/19(火) 14:01 -
引用なし
パスワード
   ▼nonoka さん：

追伸です。
休日リストは、B4から下に１列というコードにしてあります。
【73912】Re:別シート検索してマッチすれば値を＋１
発言  UO3  - 13/3/19(火) 15:31 -
引用なし
パスワード
   ▼nonoka さん：

老婆心ながら・・・

PS工程の

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

ここは　s4 でいいのですか？　s3 ではなく？
【73915】Re:別シート検索してマッチすれば値を＋１
回答  nonoka  - 13/3/19(火) 18:29 -
引用なし
パスワード
   ▼UO3 さん：

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

>
>老婆心ながら・・・
>
>PS工程の
>
>.Range("P1").Value = .Range("N1").Value + Val(s4)
>
>ここは　s4 でいいのですか？　s3 ではなく？
【73916】Re:別シート検索してマッチすれば値を＋１
質問  nonoka  - 13/3/19(火) 19:10 -
引用なし
パスワード
   ▼UO3 さん：

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


>
>こんにちは
>
>アップされたコード、各種変数がそれぞれ１４、そこへの値のセットも１４行、処理も１４・・
>というところが気になりましたので、変数を配列にして、変数定義も１行、値のセットも１行
>処理もループでコンパクトに・・・・
>
>ということでコードを書き始めたんですが、考え直しました。
>コードはコンパクトになったとしても、そのためのバグつぶしに時間がかかるかもしれませんし
>今後の、そちらでの運用過程で追加改訂なども考えられ、その時に、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
>
>で、現在、Ｎ列〜ＡＡ列に日付をセットしておられるところ、たとえば
>
> .Range("N1").Value = .Range("K1").Value + Val(s(1))
>
>ここを
>
> .Range("N1").Value = GetWorkDate(.Range("K1").Value + Val(s(1)))
>
>こんなふうに変更してみてください。
>セットしようとしている日付が休日リストにあった場合、翌日、翌々日。。。と
>一番近い営業日にかえてセットします。
【73917】Re:別シート検索してマッチすれば値を＋１
質問  nonoka  - 13/3/19(火) 19:19 -
引用なし
パスワード
   ▼UO3 さん：

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


>
>で、現在、Ｎ列〜ＡＡ列に日付をセットしておられるところ、たとえば
>
> .Range("N1").Value = .Range("K1").Value + Val(s(1))
>
>ここを
>
> .Range("N1").Value = GetWorkDate(.Range("K1").Value + Val(s(1)))
>
>こんなふうに変更してみてください。
>セットしようとしている日付が休日リストにあった場合、翌日、翌々日。。。と
>一番近い営業日にかえてセットします。
【73918】Re:別シート検索してマッチすれば値を＋１
お礼  nonoka  - 13/3/19(火) 19:37 -
引用なし
パスワード
   ▼UO3 さん：
すいません。出来ました！
休日も飛ばすことが出来ました。

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

ありがとうございました！
これで、ようやく形になりました。
UO3様様です。本当にありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1511 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free