VBA如果那么声明+左

问题描述

我是使用VBA的新手，我正在尝试使用这些规则创建代码（请参阅上下文图片）：

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

如果是B列单元格将文本GBP，然后转到C列中的相邻单元格。如果C单元格的前2个字母以RB开头，则将文本Royal Bank of Scotland发布在相邻的Cell D中，如果是第一个2个字母是HC，然后在相邻的Cell D中发布文本Corporate。

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.

如果B列单元格的文本为USD，则转到C列中的Adjacent单元格。如果C单元格的前2个字母以JP开头，然后将文本JPMorgan发布在相邻的Cell D中，如果前2个字母是BO，则将文本Bank of America发布在相邻的Cell D中。

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.

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

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.

推荐答案

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

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

这篇关于VBA如果那么声明+左的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！