Excel VBA質問箱 IV

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

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


22633 / 76733 ←次へ | 前へ→

【59478】Re:特殊な重複チェック
発言  にぃ  - 08/12/12(金) 17:39 -

引用なし
パスワード
   サンプルコードです。

Sub test1() '判定2の処理

  Dim i As Long
  Dim j As Long: j = 0 'j初期化
  Dim RowE As Long
  Dim FileNm As String
  Dim Rn As Range
  Dim StartAd As String
  
  RowE = Range("E" & Rows.Count).End(xlUp).Row 'E列の最後の文字がある行数の値
  
  For i = 2 To RowE
  
    If Range("D" & i).Value = "" Then 'D列が空白の時
    
      If Range("B" & i).Value = "" Then 'B列がまだ空白のとき
      
        j = j + 1 'jに1を足す
        FileNm = Range("E" & i).Value 'E列のファイル名を取得
        Set Rn = Range("E2:E" & RowE).Find(What:=FileNm) 'E列を参照し同じファイル名のセルを探す
        StartAd = Rn.Address '最初に見つけたセルのアドレスを覚えておく(取得)
        Do
          Range("B" & Rn.Row).Value = j 'B列の該当行に数字を記入
          Set Rn = Range("E2:E" & RowE).FindNext(Rn) '他のセルに同じファイル名があるか探す
          If Rn.Address = StartAd Then Exit Do '最初に見つけたセルのアドレスと同じならLoopをやめる
        Loop '同じファイル名があるだけLoopする
      
        Set Rn = Nothing 'Rnの解放(詳しくはHPなどで調べてください^^;)
      
      End If
    
    End If
  
  Next 'E列に文字があるだけ繰り返します

End Sub

Sub test2() '判定3の処理

  Dim i As Long
  Dim RowA As Long
  
  RowA = Range("A" & Rows.Count).End(xlUp).Row
  
  For i = 2 To RowA
  
    If Range("A" & i).Value = "×" And Range("B" & i).Value <> "" Then
    
      If Range("B" & i).Value = Range("B" & i + 1).Value Then 'B列のセルの値と1つ下の値が同じ時、1つ下のセルと比較
      
        If Range("F" & i).Value <> Range("F" & i + 1).Value And _
          Range("G" & i).Value <> Range("G" & i + 1).Value Then '二つとも違う場合
          
          Range("C" & i).Value = "サと時"
          
        ElseIf Range("F" & i).Value <> Range("F" & i + 1).Value Then 'どちらかが一緒でサイズが違うとき
        
          Range("C" & i).Value = "サイズ"
        
        ElseIf Range("G" & i).Value <> Range("G" & i + 1).Value Then 'どちらかが一緒で時間が違うとき
        
          Range("C" & i).Value = "時間"
        
        End If
      
      Else '違うとき、1つ上のセルを比較する
      
        If Range("F" & i).Value <> Range("F" & i - 1).Value And _
          Range("G" & i).Value <> Range("G" & i - 1).Value Then '二つとも違う場合
          
          Range("C" & i).Value = "サと時"
          
        ElseIf Range("F" & i).Value <> Range("F" & i - 1).Value Then 'どちらかが一緒でサイズが違うとき
        
          Range("C" & i).Value = "サイズ"
        
        ElseIf Range("G" & i).Value <> Range("G" & i - 1).Value Then 'どちらかが一緒で時間が違うとき
        
          Range("C" & i).Value = "時間"
        
        End If
      
      End If
    
    End If
  
  Next 'A列に文字があるだけ繰り返す

End Sub

Sub test3() '判定2と判定3を一緒にしたもの

  Dim i As Long
  Dim j As Long: j = 0 'j初期化
  Dim RowE As Long
  Dim FileNm As String
  Dim Rn As Range
  Dim StartAd As String
  
  RowE = Range("E" & Rows.Count).End(xlUp).Row 'E列の最後の文字がある行数の値
  
  For i = 2 To RowE
  
    If Range("D" & i).Value = "" Then 'D列が空白の時
    
      If Range("B" & i).Value = "" Then 'B列がまだ空白のとき
      
        j = j + 1 'jに1を足す
        FileNm = Range("E" & i).Value 'E列のファイル名を取得
        Set Rn = Range("E2:E" & RowE).Find(What:=FileNm) 'E列を参照し同じファイル名のセルを探す
        StartAd = Rn.Address '最初に見つけたセルのアドレスを覚えておく(取得)
        Do
          Range("B" & Rn.Row).Value = j 'B列の該当行に数字を記入
          Set Rn = Range("E2:E" & RowE).FindNext(Rn) '他のセルに同じファイル名があるか探す
          If Rn.Address = StartAd Then Exit Do '最初に見つけたセルのアドレスと同じならLoopをやめる
        Loop '同じファイル名があるだけLoopする
      
        Set Rn = Nothing 'Rnの解放(詳しくはHPなどで調べてください^^;)
      
      End If
    
    End If
  
  Next 'E列に文字があるだけ繰り返します
  
  For i = 2 To RowE
  
    If Range("A" & i).Value = "×" And Range("B" & i).Value <> "" Then
    
      If Range("B" & i).Value = Range("B" & i + 1).Value Then 'B列のセルの値と1つ下の値が同じ時、1つ下のセルと比較
      
        If Range("F" & i).Value <> Range("F" & i + 1).Value And _
          Range("G" & i).Value <> Range("G" & i + 1).Value Then '二つとも違う場合
          
          Range("C" & i).Value = "サと時"
          
        ElseIf Range("F" & i).Value <> Range("F" & i + 1).Value Then 'どちらかが一緒でサイズが違うとき
        
          Range("C" & i).Value = "サイズ"
        
        ElseIf Range("G" & i).Value <> Range("G" & i + 1).Value Then 'どちらかが一緒で時間が違うとき
        
          Range("C" & i).Value = "時間"
        
        End If
      
      Else '違うとき、1つ上のセルを比較する
      
        If Range("F" & i).Value <> Range("F" & i - 1).Value And _
          Range("G" & i).Value <> Range("G" & i - 1).Value Then '二つとも違う場合
          
          Range("C" & i).Value = "サと時"
          
        ElseIf Range("F" & i).Value <> Range("F" & i - 1).Value Then 'どちらかが一緒でサイズが違うとき
        
          Range("C" & i).Value = "サイズ"
        
        ElseIf Range("G" & i).Value <> Range("G" & i - 1).Value Then 'どちらかが一緒で時間が違うとき
        
          Range("C" & i).Value = "時間"
        
        End If
      
      End If
    
    End If
  
  Next 'A列に文字があるだけ繰り返す

End Sub
2 hits

【59462】特殊な重複チェック ほり 08/12/12(金) 10:38 質問
【59465】Re:特殊な重複チェック かみちゃん 08/12/12(金) 12:20 発言
【59466】Re:特殊な重複チェック ほり 08/12/12(金) 13:08 回答
【59467】Re:特殊な重複チェック にぃ 08/12/12(金) 14:23 発言
【59468】Re:特殊な重複チェック ほり 08/12/12(金) 14:45 発言
【59470】Re:特殊な重複チェック Abebobo 08/12/12(金) 15:14 発言
【59471】Re:特殊な重複チェック にぃ 08/12/12(金) 15:18 発言
【59472】Re:特殊な重複チェック neptune 08/12/12(金) 15:26 発言
【59476】Re:特殊な重複チェック ほり 08/12/12(金) 17:04 お礼
【59477】Re:特殊な重複チェック にぃ 08/12/12(金) 17:37 発言
【59478】Re:特殊な重複チェック にぃ 08/12/12(金) 17:39 発言
【59479】Re:特殊な重複チェック にぃ 08/12/12(金) 17:48 発言
【59480】Re:特殊な重複チェック ほり 08/12/12(金) 17:54 お礼

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