从另一个工作表的列表中查找作为工作表的值,并为整行着色

时间:2017-02-03 08:59:27

标签: excel vba excel-vba

我在第一栏的第1页中有值,这个数字可能会有所不同。

我想在工作表2中找到这些值并为整个行着色,其中这些值在工作表2中。

services.AddTransient<IProfileService, GabeFcCustomProfileService>();

2 个答案:

答案 0 :(得分:1)

编辑添加解决方案

你正在变暗FindString As Range,但后来将它用作数组(FindString = someRange.Value

最好使用AutoFilter()

我不确定您是在列A中搜索FindString值还是在Sheet2的列A:AZ中搜索,所以我发布了两个选项的代码

在Sheet2的A列中搜索FindString值

Sub main2()
    Dim FindString As Variant

    With Worksheets("Sheet1")
        FindString = Application.Transpose(.Range("I2", .Cells(.Rows.Count, "I").End(xlUp).Offset(1)).Value)
    End With
    With Sheets("Sheet2").Range("A1:AZ500")
        .AutoFilter Field:=1, Criteria1:=FindString, Operator:=xlFilterValues
        If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then
            With .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Interior
                .Pattern = xlSolid
                .Color = 255
            End With
        End If
        .Parent.AutoFilterMode = False
    End With
End Sub

在列A的列中搜索FindString值:Sheet2的AZ

Option Explicit

Sub main2()
    Dim FindString As Variant
    Dim col As Range

    With Worksheets("Sheet1")
        FindString = Application.Transpose(.Range("I2", .Cells(.Rows.Count, "I").End(xlUp).Offset(1)).Value)
    End With

    With Sheets("Sheet2").Range("A1:AZ500")
        For Each col In .Columns
            .AutoFilter Field:=col.Column, Criteria1:=FindString, Operator:=xlFilterValues
            If Application.WorksheetFunction.Subtotal(103, col.Cells) > 1 Then
                With .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Interior
                    .Pattern = xlSolid
                    .Color = 255
                End With
            End If
            .Parent.AutoFilterMode = False
        Next
    End With
End Sub

答案 1 :(得分:1)

FindString实际上是一个数组,所以我改变了它的声明。

但是你需要在该数组上循环以搜索所有值:
 For i = LBound(FindString, 1) To UBound(FindString, 1)

由于您可能在第二张表中只有一次没有此值,因此您需要使用FindNext

Dim FindString() As Variant
Dim Rng As Range
Dim i As Long
Dim FirstAddress As String
Dim LastRow As Long

With Sheets("Sheet1")
    LastRow = .Range("J" & .Rows.Count).End(xlUp).Row
    If LastRow > 2 Then
        FindString = .Range("J2:J" & LastRow).Value
    Else
        ReDim FindString(1 To 1, 1 To 1)
        FindString(1,1) = .Range("J2").Value
    End If
End With 'Sheets("Sheet1")

For i = LBound(FindString, 1) To UBound(FindString, 1)
    If Trim(FindString(i, 1)) <> vbNullString Then
        With Sheets("Sheet2").Range("A1:AZ500")
            Set Rng = .Find(What:=FindString(i, 1), _
                            After:=.Cells(1, 1), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)


            If Not Rng Is Nothing Then
                With Rng
                    FirstAddress = .Address
                    Do
                        With .EntireRow.Interior
                            .Pattern = xlSolid
                            .Color = 255
                        End With
                        Set Rng = .FindNext(Rng)
                    'Look until you find again the first result
                    Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
                End With 'Rng
            End If
        End With 'Sheets("Sheet2").Range("A1:AZ500")
    Else
    End If
Next i