Выделение значения на основе условий в Excel VBA - PullRequest
Новая
       11

Выделение значения на основе условий в Excel VBA

0 голосов
/ 07 мая 2018

Я новичок в VBA, Нужна помощь. В моем превосходстве я хочу выделить столбец, если статус в процессе. Сначала я должен разделить поле B запятой, затем, если статус «В процессе», я хочу выделить дублирующее значение. 

 S.no.     Task          Status  
1.         abc         In progress  
2.         abc,efg     Not Started 



S.no.     Task          Task2          Status  
1.         abc                   In progress  
2.         **abc**      efg     Not Started 



    range for checking duplicates should be both Task and Task 2

    Now this is my code. Any help will be appreciated.

Sub GetAlert () 

    Dim sht1 As Worksheet
    Dim AssociatedVal As String
    Dim AssociatedArr() As String
    Dim Arr As Variant
    Dim matchFoundIndex As Long
    Dim iCntr As Long
    Dim lcol As Long
    Dim data As Range


    Set sht1 = ThisWorkbook.Sheets(1)
    tRows = sht1.Cells(Rows.Count, 1).End(xlUp).Row
    lcol = sht1.Cells(1, Columns.Count).End(xlToLeft).Column

    For Row = 2 To tRows

    AssociatedVal = sht1.Cells(Row, 3).Value


    AssociatedArr() = Split(AssociatedVal, ",")
     Arr = UBound(AssociatedArr) - LBound(AssociatedArr)
    For i = 0 To Arr
        sht1.Cells(Row, lcol + (i + 1)).Value = AssociatedArr(i)
    Next
       For iCntr = 2 To tRows
        If Cells(iCntr, 7) <> "" Then
            'Sheets("Sheet1").Range("$G$1:$H$" & tRows).FindDuplicates Columns:=Array(1, 2), Header:=xlYes
                matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 7), Range("G1:G" & tRows), 0)
                'If Application.CountIf(Range("G:G"), Target) > 1 Then
                If iCntr <> matchFoundIndex Then
                Cells(iCntr, 11) = "Duplicate"
           End If

            End If
            If Cells(iCntr, 4).Value = "In Progress" And Cells(iCntr, 11).Value = "Duplicate" Then
            Cells(iCntr, 3).Interior.ColorIndex = 3
            End If
    Next
    'Next Arr
    Next
    MsgBox "Fetched"
    End Sub
...