Scripting.Dictionary для заполнения столбца строкой с учетом более 3 критериев

Question

Я пытаюсь заполнить столбец C строкой, учитывающей, соответствует ли потребитель в строке одному из критериев:

Если потребитель соответствует одному из этих правил, значение должно быть установлено на Рассмотрение: • Потребитель имеет только 1 транзакцию - (выполнено) • Потребитель имеет 2–4 транзакции, но общий объем< 10000 долларов США --- (выполнено) • Уровень потребителя (на основе правила ниже) - Уровень 2 или Уровень 3 --- (эта информация находится в столбцах CV и CW)• Если раскрывающийся список составляет 60 дней, а максимальная дата транзакции старше 30 дней • Если раскрывающееся меню составляет 1 год и максимум дата транзакции старше 90 дней • Если раскрывающееся меню составляет 5 лет, а максимальная дата транзакции старше 180 дней

'Interdction Review Tab, column C
Sheets("Interdiction Review").Columns(3).Font.Bold = True
Sheets("Interdiction Review").Columns(3).HorizontalAlignment = xlCenter
'Consumer has only 1 Transaction, the value on Interdiction Review Tab on Column C will be Consider
Dim wsStart As Worksheet, lastRow1 As Long, wsFinal As Worksheet
Dim dict As Object, rw As Range, v, v2, k, m, lin
Dim wsSSart As Worksheet
Dim dateDifference As Long
Dim SStartSelection As String
Dim isConsider As Boolean
Dim valid_col(1) As Integer
Dim lvl As Boolean
Set wsSSart = ActiveWorkbook.Sheets("SStart")
Set wsStart = ActiveWorkbook.Sheets("Start")
Set wsFinal = ActiveWorkbook.Sheets("Interdiction Review")
lastRow1 = wsStart.Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set dict = CreateObject("Scripting.Dictionary")
SStartSelection = wsSSart.Cells(7, "A").Value
lvl = False
For Each rw In wsStart.Range("A2:AJ" & lastRow1).Rows
v = rw.Cells(8).Value
v2 = rw.Cells(36).Value
If Len(v) = 0 Or Len(v2) = 0 Then
v = rw.Cells(7).Value
v2 = rw.Cells(35).Value
End If
dict(v) = dict(v) + 1
dict(v2) = dict(v2) + 1
Next rw
For Each k In dict
isConsider = False
m = Application.Match(k, wsFinal.Columns(1), 0)
wsFinal.Cells(m, 7).FormulaArray = wsFinal.Cells(m, 7).Formula
dateDifference = DateDiff("D", wsFinal.Cells(m, 7).Value, Date)
If dict(k) = 1 Then
isConsider = True
ElseIf dict(k) >= 2 And dict(k) <= 4 And wsFinal.Cells(m, 6).Value <= 10000 Then
isConsider = True
End If
If StrComp(SStartSelection, "60 Days") = 0 And dateDifference > 30 Then
isConsider = True
ElseIf StrComp(SStartSelection, "1 Year") = 0 And dateDifference > 90 Then
isConsider = True
ElseIf StrComp(SStartSelection, "5 Years") = 0 And dateDifference > 180 Then
isConsider = True
End If
'Client number
If wsStart.Cells(2, 8) <> "" Then
valid_col(0) = 8
valid_col(1) = 36
Else
valid_col(0) = 7
valid_col(1) = 35
End If
'Level verification
For lin = 2 To lastRow1
If wsStart.Cells(lin, valid_col(0)) = k Then
If wsStart.Cells(lin, 100).Value = "Level 2" Or wsStart.Cells(lin, 100).Value = "Level 3" Then
lvl = True
Exit For
End If
End If
If wsStart.Cells(lin, valid_col(1)) = k Then
If wsStart.Cells(lin, 101).Value = "Level 2" Or wsStart.Cells(lin, 101).Value = "Level 3" Then
lvl = True
Exit For
End If
End If
Next lin
If isConsider And lvl Then
If Not IsError(m) Then wsFinal.Cells(m, 3).Value = "Consider"
End If
Next k
End Sub

Кажется, что мой код ищет не в том столбце, чтобы проверить уровень клиентов. Пример: Клиент номер 3 расположен в столбце H, поэтому код должен проверить столбец CV, чтобы увидеть, что уровень клиента номер 3 также расположен в столбце AJ, код должен проверить столбец CW, чтобы увидеть уровень. если клиент находится в обоих столбцах, и треску необходимо проверить оба столбца для поиска информации.

Уровень для столбца CV - это когда номер клиента находится в столбце H или / и G. Уровень для столбца CW - когда клиент находится в столбце AJ или / и AI.

Я тоже спросил здесь (и вы можете скачать файл)https://www.ozgrid.com/forum/index.php?thread/1228270-how-to-populate-a-column-with-a-string-taking-in-рассмотрение-5-разные-crite/ & postID = 1239894#post1239941

Answer 1

Единственный раз, когда lvl установлено значение False перед For Each k In dict цикл когда-либо случается.

Итак, как только определенная строка устанавливает lvl в True в этом цикле каждая последующая строка также будет иметь lvl быть True, потому что в цикле нечего устанавливать lvlназад к False. Попробуйте вместо этого:

For Each k In dict
  isConsider = False
  lvl = False

Answer 2

Ваш код слишком велик. Я не думаю, что вы получите желаемый ответ, потому что на поиск проблемы уходит много времени. Поэтому я научу вас, как структурировать код таким образом, чтобы можно было обсудить любую его часть. Пожалуйста, обратите внимание на приведенный ниже код.

Sub NewTest()
    ' 093
    
    Dim WsIR As Worksheet
    
    Set WsIR = CreateWsIR()
    Worksheets("Start").Activate        ' probably not useful
End Sub

Private Function CreateWsIR() As Worksheet
    ' 093
    
    Dim Fun As Worksheet                ' = Function return object under preparation
    
    Set Fun = Worksheets.Add            ' Excel will make this the ActiveSheet
    With Fun
        .Name = "Interdiction Review"
        .Move After:=Worksheets("Start")
        ' format your sheet here
    End With
    
    Set CreateWsIR = Fun
End Function

Посмотрите на преимущества этой конструкции.

1. Первые 30 с лишним строк вашего кода сжимаются в одну.
2. Это позволяет четко развить повествование в основной процедуре.
3. Между тем все, что связано с созданием нового рабочего листа, объединено в одну отдельную процедуру, которую легко протестировать, легко поддерживать и легко задать вопросы, если возникнет такая необходимость.

По мере того, как вы продолжаете создавать повествование своего проекта, вы подойдете к точке, где задача состоит в том, чтобы заполнить столбец C. С помощью вышеупомянутого метода процесс фильтрации и исключения будет происходить в функции, которая является отдельной, как и функция CreateWsIRотдельно выше. Он вернет одно значение, которое вы вставите в ячейку в основной процедуре. В вашей нынешней настройке вы даже не можете точно определить, где происходит это действие (и мы не можем). Если вы измените структуру, чтобы сделать ее более прозрачной, у вас не возникнет такой проблемы, и мы будем рады помочь.