| |
ウッシ さん
おはようございます。昨日はありがとうございました。
さっそくSub データ照合1()をtestデータで試してみました。
ステップ実行で確認しましたが、不備データのセルは「赤」にならず
そのまま終了しました。
(「If Not r Is Nothing Then」から「End If」に飛び、特にエラーも
出ませんでした)
またSub データ照合1()の応用編として
・「項目1」のデータが「AAA」、「項目2」のデータが「BBB」以外の場合、
「項目2」のセルを赤く表示
・「項目1」のデータが「AAA」、「項目2」のデータが「BBB」(数値)より大きい
の場合、「項目2」のセルを赤く表示
を考えてみたいのですが、条件式のしくみがどうしても分かりません。
お手数ですがどこを直せばよいのかご指導下さい。
どうかよろしくお願い致します。
>Sub データ照合1()
>'「項目1」のデータが「AAA」、「項目2」のデータが「BBB」の場合、
>'「項目2」のセルを赤く表示
> Const 項目1_Dat As Variant = "AAA"
> Const 項目2_Dat As Variant = "BBB"
>
> Dim 項目1_Col As Variant
> Dim 項目2_Col As Variant
> Dim g As Long
> Dim r As Range
> Dim newBk As Workbook
>
> With ActiveSheet
> 項目1_Col = Application.Match("項目1", .Rows(1), 0)
> 項目2_Col = Application.Match("項目2", .Rows(1), 0)
> If IsError(項目1_Col) Then Exit Sub
> If IsError(項目2_Col) Then Exit Sub
>
> g = ActiveWindow.ActiveCell.Row
> With .Range("IV" & g & ":IV" & .Range("A65536").End(xlUp).Row)
> .FormulaR1C1 = _
> "=IF(AND(RC" & 項目1_Col & "=""" & 項目1_Dat & _
> """,RC" & 項目2_Col & "=""" & 項目2_Dat & _
> """),1,"""")"
> .Value = .Value
> On Error Resume Next
> Set r = .SpecialCells(xlCellTypeConstants)
> On Error GoTo 0
> If Not r Is Nothing Then
> Set newBk = Workbooks.Add
> Intersect(r.EntireRow, .Parent.Columns(項目2_Col)) _
> .Interior.ColorIndex = 3
> r.EntireRow.Copy newBk.Worksheets(1).Range("A1")
> newBk.SaveAs ThisWorkbook.Path & "\エラーデータ.xls"
> End If
> .ClearContents
> End With
> End With
>End Sub
|
|
KOTARO
- 05/4/15(金) 11:17 -
