VBA 问题 - 尝试连接和循环

Question

所以我需要转到每一行，根据可能的付款人列表评估字符串，然后返回该特定付款人的公式。但是我不断收到错误，有人可以帮我弄清楚我的代码有什么问题吗？我是编程新手，无法弄清楚问题所在。

Sub CkNoConcatenate()
'
' CkNoConcatenate Macro
'

'
    Dim x As Range, y As Range, c As String
    rnumbers = Rows(ActiveCell.Range("A2").End(xlDown))
    Set x = ActiveSheet.Range("AL2:AL3000")
    Set y = ActiveSheet.Range("AS2:AS3000")
    
    For Each cell In x
    If c Is "AETNA A04" Or "AETNA AS01" Or "AETNA H09" Or "CIGNA" Or "HUMANA AHP" Or "HUMANA INS CO" Or "HWHO" Or "HHP" Then
    y = FormulaR1C1 = "=CONCATENATE(RC[-7],"" - "",LEFT(RC[4],15))"
    ElseIf c = "AARP SUPPLEMENTA" Or "ANTHEM BLUE IN5C" Or "ANTHEM BLUE IN5F" Or "ANTHEM BLUE O5C" Or "HUMANA GOVT BUSI" Or "MARKETPLACE" Or "MCRIN CLAIMS" Or "OPTUM VA CCN REG" Or "WISCONSIN PHYSIC" Or "UNITEDHEALTHCARE" Or "MANAGED HEALTH" Then
    y = FormulaR1C1 = "=CONCATENATE(RC[-7],"" - "",LEFT(RC[4],10))"
    ElseIf c = "CIGNA EDGE TRANS" Then
    y = FormulaR1C1 = "=CONCATENATE(RC[-7],"" - "",LEFT(RC[4],12))"
    ElseIf c = "GERBER LIFE INS" Or "GPM HEALTH INS" Or "MUTUAL OF OMAHA" Or "OMAHA INS CO" Or "UNITED OF OMAHA" Or "UNITED WORLD" Then
    y = FormulaR1C1 = "=CONCATENATE(RC[-7],"" - "",LEFT(RC[4],28))"
    ElseIf c = "GOLDEN RULE INSU" Then
    y = FormulaR1C1 = "=CONCATENATE(RC[-7],"" - "",LEFT(RC[4],13))"
    ElseIf c = "WPS" Or "HNB - ECHO" Or "UHC GOVERNMENT E" Or "UMR" Or "UMR CITY OF HEND" Or "UMR COMPASS ROSE" Or "UMR FREEDOM MORT" Or "UMR NRECA" Or "UMR PEDCOR MANAG" Or "UMR SMC CORPORAT" Or "UNITED BEHAVIORA" Or "UMR THE CHRISTIA" Or "UMR WABASH NATIO" Then
    y = FormulaR1C1 = "=CONCATENATE(RC[-7],"" - "",LEFT(RC[4],9))"
    Else: y = x
    End If
    Next cell
     
End Sub

Answer 1

我认为这种模式会更好。

不过，请听从 @JohnColeman 的建议 - 如果您想继续这样做，您需要对基础知识有更扎实的了解。

Sub CkNoConcatenate()

    Dim cell As Range, n As Long
    
    For Each cell In ActiveSheet.Range("AL2:AL3000").Cells
    
        'how many characters are we extracting?  (Some names omitted for clarity)
        Select Case cell.Value
            Case "AETNA A04", "AETNA AS01", "AETNA H09", "CIGNA"
                n = 15
            Case "AARP SUPPLEMENTA", "ANTHEM BLUE IN5C", "ANTHEM BLUE IN5F"
                n = 10
            Case "CIGNA EDGE TRANS"
                n = 12
            Case "GERBER LIFE INS", "GPM HEALTH INS", "MUTUAL OF OMAHA", "OMAHA INS CO"
                n = 28
            Case "GOLDEN RULE INSU"
                n = 13
            Case "WPS", "HNB - ECHO", "UHC GOVERNMENT E", "UMR", "UMR CITY OF HEND"
                n = 9
            Case Else
                n = 0
        End Select
        
        With cell.EntireRow
            'range addresses below are *relative* to the row
            .Range("AS1").Value = IIf(n = 0, cell.Value, _
                                     .Range("AL1").Value & " - " & Left(.Range("AW1").Value, n))
        End With
    
    Next cell
     
End Sub

Answer 2

第二个答案展示了如何使用 scripting.dictionary 来简化您的（和 Tims Case 语句）代码。

Option Explicit

Const Action1 As String = "=CONCATENATE(RC[-7],"" - "",LEFT(RC[4],15))"
Const Action2 As String = "=CONCATENATE(RC[-7],"" - "",LEFT(RC[4],10))"
Const Action3 As String = "=CONCATENATE(RC[-7],"" - "",LEFT(RC[4],12))"
Const Action4 As String = "=CONCATENATE(RC[-7],"" - "",LEFT(RC[4],28))"
Const Action5 As String = "=CONCATENATE(RC[-7],"" - "",LEFT(RC[4],13))"
Const Action6 As String = "=CONCATENATE(RC[-7],"" - "",LEFT(RC[4],9))"

Private Payers As scripting.Dictionary



Sub CkNoConcatenate()
'
' CkNoConcatenate Macro
'
    ' In the next row you delare c as a string but you never assign a value to it
    Dim x As Range, y As Range, c As String
    
    ' You don't declare rnumbers but also you never use the value
    rnumbers = Rows(ActiveCell.Range("A2").End(xlDown))
    
    Set x = ActiveSheet.Range("AL2:AL3000")
    Set y = ActiveSheet.Range("AS2:AS3000")
    If Payers Is Nothing Then SetupPayers
    ' Cell is just a Bad bad bad name for a VBA variable as it has potential clashes
    ' with keywords used in the various Office object models
    '  In a for each loop the control variable 'myCell' must be a variant (or a suitable object)
    Dim myCell As Variant
    For Each myCell In x
    
        '  This is where we simplify your complex if/elseif/else/end
        
        If Payers.Exists(Cell.value2) Then
        
            ' I've no idea if the two lines below are what you intended.
            ' replace them with something meaningful.
            ' Others have given you advice on why your original code was incorrrect
            FormulaR1C1 = Payers.Item(Cell.value2)
            y = FormulaR1C1
            
        Else
    
            y = x
         
        End If
        
    Next
     
End Sub



Public Sub SetupPayers()
    
    Set Payers = New scripting.Dictionary
        
    With Payers
    
        'Action1 payers
        .Add "AETNA A04", Action1
        .Add "AETNA AS01", Action1
        .Add "AETNA H09", Action1
        .Add "CIGNA", Action1
        .Add "HUMANA AHP", Action1
        .Add "HUMANA INS CO", Action1
        .Add "HWHO", Action1
        .Add "HHP", Action1
        
        'Action2 payers
        .Add "AARP SUPPLEMENTA", Action2
        .Add "ANTHEM BLUE IN5C", Action2
        .Add "ANTHEM BLUE IN5F", Action2
        .Add "ANTHEM BLUE O5C", Action2
        .Add "HUMANA GOVT BUSI", Action2
        .Add "MARKETPLACE", Action2
        .Add "MCRIN CLAIMS", Action2
        .Add "OPTUM VA CCN REG", Action2
        .Add "WISCONSIN PHYSIC", Action2
        .Add "UNITEDHEALTHCARE", Action2
        .Add "MANAGED HEALTH", Action2
        
        'Action3 payers
        .Add "CIGNA EDGE TRANS", Action3
        
        'Action4 Payers
        .Add "GERBER LIFE INS", Action4
        .Add "GPM HEALTH INS", Action4
        .Add "MUTUAL OF OMAHA", Action4
        .Add "OMAHA INS CO", Action4
        .Add "UNITED OF OMAHA", Action4
        .Add "UNITED WORLD", Action4
        
        'Action5 payers
        .Add "GOLDEN RULE INSU", Action5
        
        'Action6 payers
        .Add "WPS", Action6
        .Add "HNB - ECHO", Action6
        .Add "UHC GOVERNMENT E", Action6
        .Add "UMR", Action6
        .Add "UMR CITY OF HEND", Action6
        .Add "UMR COMPASS ROSE", Action6
        .Add "UMR FREEDOM MORT", Action6
        .Add "UMR NRECA", Action6
        .Add "UMR PEDCOR MANAG", Action6
        .Add "UMR SMC CORPORAT", Action6
        .Add "UNITED BEHAVIORA", Action6
        .Add "UMR THE CHRISTIA", Action6
        .Add "UMR WABASH NATIO", Action6
        
    End With
    
End Sub