Excel VBA質問箱 IV

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

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


8403 / 76732 ←次へ | 前へ→

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

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