Scripting.Dictionary使用多于3个条件的字符串填充一列

问题描述

我正在尝试用字符串填充C列,考虑行上的使用者是否符合以下条件之一:

如果使用者符合以下规则之一,则该值应设置为“考虑”: •消费者只有1笔交易-(已完成) •消费者进行了2-4次交易,但总交易额•消费者级别(基于以下规则)是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-consideration-5-different-crite/&postID=1239894#post1239941

解决方法

RenderObject设置为False的唯一时间是在lvl循环发生之前。

因此,一旦特定行在该循环中将For Each k In dict设置为True,则随后的每一行也将lvl设置为True,因为循环中没有任何内容可以将lvl设置为True。假。尝试以下方法:

lvl
,

您的代码太大。我认为您不会因为找到问题的时间而得到想要的答案。因此,我将教您如何构造代码,以便能够讨论其中的任何部分。请考虑以下代码。

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的位置。使用上述方法,过滤和消除过程将在一个与功能{ {1}}在上面是单独的。它将返回一个值,您将在主过程中将其插入到单元格中。在您当前的设置中,您甚至无法查明该操作的发生位置(我们也不能)。如果您更改结构以使其更加透明,那么您就不会有这样的问题,我们很乐意为您提供帮助。

相关问答

错误1:Request method ‘DELETE‘ not supported 错误还原:...
错误1:启动docker镜像时报错:Error response from daemon:...
错误1:private field ‘xxx‘ is never assigned 按Alt...
报错如下,通过源不能下载,最后警告pip需升级版本 Requirem...