Question

我对使用VBA非常陌生，我正在尝试使用这些规则创建代码（请参阅上下文图片）：

如果B列单元格有文本＆＃34; GBP＆＃34;，则转到C列中的相邻单元格。如果C单元格的前2个字母以RB开头，则发布文本＆＃34苏格兰皇家银行＆＃34;在相邻的单元格D中，如果前两个字母是HC，则发布文本＆＃34; Corporate＆＃34;而是在相邻的Cell D中。

如果B列单元格的文本为＆＃34; USD＆＃34;，则转到C列中的相邻单元格。如果C单元格的前2个字母以JP开头，则发布文本＆＃34 ;摩根＆＃34;在相邻的Cell D中，如果前两个字母是BO，那么发布文本＆＃34; Bank of America＆＃34;而是在相邻的Cell D中。

我可以使用excel公式手动完成所有这些操作，但是，有很多信息，我试图找出一种自动执行此操作的方法。

Problem image

Answer 1

我更喜欢一个公式，但是因为你要求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

Answer 2

以下代码应该这样做。该代码假定数据位于名为“Data”的工作表中，从第3行开始，所需的替换位于另一个名为“Replacements”的工作表中。在最后一页中，从第一行开始，您必须使用货币（GBP或USD）填充A列，使用两个字母代码（RB，HC等）填充B列，使用所需替换填充C列（Bank of America）等）。在您当前的示例中，应该有8行数据（4行显示在第26-29行，一行显示为GBP，另一行显示为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

Answer 3

在D4中，应用以下公式并向下拖动

注意：根据上下文/示例，我已经取了C列中的前三个字符

=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"))))))))

VBA如果那么声明+左

3 个答案: