Excel VBA質問箱 IV

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

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


8440 / 76732 ←次へ | 前へ→

【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
292 hits

【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 回答

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