复杂如果VBA为亲

时间:2013-05-13 10:16:42

标签: excel vba excel-vba

我有3个文件

我需要做什么(必须使用VBA excel,因为它是一个更大的宏的一部分)是查看文档A中的A列以及文档B列AI中匹配的每个实例需要检查两个文档的B列中的值是否为“rf”,如果是,我需要检查工作簿A的C列中的值是否> C栏。

如果一切正确,我想将工作簿A列的值发布到同一单元格地址中的工作簿C列C中。

我有下面的代码但它在第一个交叉循环上返回一个错误,说明“对象'_global'的'方法'相交'失败。有没有想过为什么会发生这种情况?

Public Sub RFErrorProof()

Dim input1 As String
Dim input2 As String
Dim rCell As Range
Dim rFound As Range
Dim rNext As Range

Input3 = "ReportCompare.xls"
input1 = Workbooks(Input3).Worksheets("Sheet4").Range("A4").Value
input2 = Workbooks(Input3).Worksheets("Sheet4").Range("A3").Value

'Loop through column A in doc A
    For Each rCell In Intersect(Workbooks(input2).Worksheets("LocalesMallContratos").UsedRange.Columns(2), Workbooks(input1).Worksheets("LocalesMallContratos").UsedRange.Columns(2)).Cells
    'Skip cells where column B is not RF
    If rCell.Offset(0, 3).Value = "RF" Then

        'See if that exists in doc B
        Set rFound = Nothing
        Set rFound = Workbooks(input1).Columns(2).Find(rCell.Value, , xlValues, xlWhole)

        'If it's in doc B
        If Not rFound Is Nothing Then

            'If column B doc B is RF and doc A is greater than doc B, then write it
            If rFound.Offset(0, 3).Value = "RF" Then
                If rCell.Offset(0, 14).Value > rFound.Offset(0, 14).Value Then
                    Set rNext = Workbooks(Input3).Cells(Workbooks(Input3).Sheets("sheet1").Rows.Count, 1).End(xlUp).Offset(1, 0)
                    rNext.Value = rCell.Value
                End If
            Else
                'If column B doc B is not RF, write it
                Set rNext = Workbooks(Input3).Cells(Workbooks(Input3).Sheets("sheet1").Rows.Count, 1).End(xlUp).Offset(1, 0)
                rNext.Value = rCell.Value
            End If
        End If
    End If
Next rCell


End Sub

2 个答案:

答案 0 :(得分:0)

我99%肯定这可以以极好的方式简化,但我只是完全按照你的逻辑完成并提出了这个公式(我认为没有必要使用VBA)。

只需将此公式复制到工作表C,单元格A1并将其复制/粘贴:

=IF(A!A1=B!A1,IF(A!B1="RF",IF(B!B1<>"RF",A!A1,IF(A!C1>B!C1,A!A1,"")),""),"")

希望这可以解决问题!

答案 1 :(得分:0)

始终在数据副本上测试代码。先备份。

Public Sub MakeDocuC()

    Dim rCell As Range
    Dim rFound As Range
    Dim rNext As Range

    'Loop through column A in doc A
    For Each rCell In Intersect(docuA.UsedRange, docuA.Columns(1)).Cells
        'Skip cells where column B is not RF
        If rCell.Offset(0, 1).Value = "RF" Then

            'See if that exists in doc B
            Set rFound = Nothing
            Set rFound = docuB.Columns(1).Find(rCell.Value, , xlValues, xlWhole)

            'If it's in doc B
            If Not rFound Is Nothing Then

                'If column B doc B is RF and doc A is greater than doc B, then write it
                If rFound.Offset(0, 1).Value = "RF" Then
                    If rCell.Offset(0, 2).Value > rFound.Offset(0, 2).Value Then
                        Set rNext = docuC.Cells(docuC.Rows.Count, 1).End(xlUp).Offset(1, 0)
                        rNext.Value = rCell.Value
                    End If
                Else
                    'If column B doc B is not RF, write it
                    Set rNext = docuC.Cells(docuC.Rows.Count, 1).End(xlUp).Offset(1, 0)
                    rNext.Value = rCell.Value
                End If
            End If
        End If
    Next rCell

End Sub