VBA If then statement + left

问题

I'm very new to using VBA, and I am trying to create a code with these rules (Please see image for context):

If Column B cell has the text "GBP", then go across to the Adjacent cell in Column C. If the first 2 letters of the C cell begins with RB, then post the text "Royal Bank of Scotland" in an adjacent Cell D, if the first 2 letters are HC, then post the text "Corporate" in an adjacent Cell D instead.

If Column B cell has the text "USD", then go across to the Adjacent cell in Column C. If the first 2 letters of the C cell begins with JP, then post the text "JPMorgan" in an adjacent Cell D, if the first 2 letters are BO, then post the text "Bank of America" in an adjacent Cell D instead.

I can do all this manually using excel formulas, however, there's quite a lot of information and Im trying to figure out an automated way of doing this.

Problem image

回答1:

The following code should do. The code assumes that the data is in a sheet named "Data", starting in row 3, and the desired replacements are in another sheet named "Replacements". In this last sheet, starting in the firt row, you must fill column A with Currency (GBP or USD), column B with the two letters code (RB, HC and so on) and column C with the desired substitution (Bank of America, etc.). In your current example, there should be 8 rows of data (the 4 lines that appear in lines 26-29, once for GBP and again for USD).

Sub ReplaceBankName()
    Dim sReplacementArray() As Variant
    Dim lLastRowReplacements As Integer
    Dim lLastRowData As Integer
    Dim r As Long, c As Long
    Dim ValToFind1 As String
    Dim ValToFind2 As String


    lLastRowReplacements = Worksheets("Replacements").Cells(Rows.Count, 1).End(xlUp).Row
    lLastRowData = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row

    'Create an array with replacement data
    For i = 1 To lLastRowReplacements
        ReDim Preserve sReplacementArray(1 To 3, 1 To i)
        sReplacementArray(1, i) = Worksheets("Replacements").Cells(i, 1).Value
        sReplacementArray(2, i) = Worksheets("Replacements").Cells(i, 2).Value
        sReplacementArray(3, i) = Worksheets("Replacements").Cells(i, 3).Value
    Next

    'Now array has replacemente data
    'if you wish to know array elements, uncomment next three lines

    'For c = 1 To UBound(sReplacementArray, 2)
    '    MsgBox "Currency: " & sReplacementArray(1, c) & " - BankCode: " & sReplacementArray(2, c) & " - Replacement: " & sReplacementArray(3, c)
    '    Next c

    For i = 3 To lLastRowData 'Scan all rows with data
        'Get values from column B (ValToFind1) and C (ValToFind2, first two letters only)
        ValToFind1 = Worksheets("Data").Cells(i, 2).Value
        ValToFind2 = Left(Worksheets("Data").Cells(i, 3).Value, 2)

        'Find those to values in the array, and write the replacement in column D
        For r = 1 To UBound(sReplacementArray, 1)
            For c = 1 To UBound(sReplacementArray, 2)
                If (sReplacementArray(1, c) = ValToFind1 And sReplacementArray(2, c) = ValToFind2) Then
                    Worksheets("Data").Cells(i, 4).Value = sReplacementArray(3, c)
                End If
            Next c
         Next r
    Next i

End Sub

回答2:

I would prefer a formula, but since you asked for VBA:

Sub marine()
    Dim ws As Worksheet
    Dim i As Long
    Set ws = ActiveSheet
    With ws
        For i = 4 To 20
            Select Case Left(.Cells(i, 3), 3)
                Case "RBS"
                    .Cells(i, 4) = "Royal Bank of Scotland"
                Case "HCN"
                    .Cells(i, 4) = "Corporate"
                Case "JPM"
                    .Cells(i, 4) = "JPMorgan"
                Case "BOM"
                    .Cells(i, 4) = "Bank of America"
                Case Else
                    MsgBox "This Bank does not exist :-D"
            End Select
        Next i
    End With
End Sub

回答3:

In D4, Apply the below formula and drag down

Note: As per the Context/Example, i have taken the first three characters in C column

=IF(AND(B4="GBP",LEFT(C4,3)="RBS"),"RoyalBankofScotland",IF(AND(B4="GBP",LEFT(C4,3)="HCN"),"Corporate",IF(AND(B4="GBP",LEFT(C4,3)="JPM"),"JP Morgan",IF(AND(B4="GBP",LEFT(C4,3)="BOM"),"Bank of America",IF(AND(B4="USD",LEFT(C4,3)="RBS"),"RoyalBankofScotland",IF(AND(B4="USD",LEFT(C4,3)="HCN"),"Corporate",IF(AND(B4="USD",LEFT(C4,3)="JPM"),"JP Morgan",IF(AND(B4="USD",LEFT(C4,3)="BOM"),"Bank of America","Not Available"))))))))

来源：https://stackoverflow.com/questions/38914004/vba-if-then-statement-left

标签

arrays

excel-vba

if-statement

automation

vba