检查字符串是否缩写并复制完整的字符串。 (Vba)

Question

我正在构建一级市场中公司债务问题的历史排除数据。

我需要宏

1. 读取每个单元格并检查它是否包含许多的缩写 选项，并根据缩写，将完整的值复制到 同一行的下一个空单元格。

2. 将先前的字符串值复制到“P”以获取对应的 项目符号 1 中的缩写，在同一行的下一个 empy 单元格中。

3. 将所有先前的字符串值复制到“E”中找到对应的“P” 项目符号 2 和项目符号 1 中的缩写，位于 同一行。

在此之后重复单元格中找到的所有缩写词。

+---+--------------------------------------------------------------------+
|                              what I have                               | 
+---+--------------------------------------------------------------------+
|   |                                 A                                  |
+---+--------------------------------------------------------------------+
| 1 | B.Corp. - 2P. 5E,6E y 9E                                           |
| 2 | B.Corp - 2P, 2E y 5E - C.D.N. 2P 4E                                |
| 3 | B.Corp. 1P 6E,7E,9E,10E,11E,12E,13E,14E,15E,17E,19E,20E,21E,22E,23E|
| 4 | I.C.P. 2P 5E 6E y 7E -  B.Corp. 3P 2E y 3E                         |
| 5 | I.C.P.  4P 1E- I.C.P 3P 3E- B.Corp. 1P 1E 3E 4E y 6E               |
+---+--------------------------------------------------------------------+

对于第5行的情况

+---+-----------------------------------------------------------------------------------------------------------+
|                            what I need                                                                        |
+---+--------------------------+---+---+--------------------------+---+---+-----------------+---+---+---+---+---+
|   |             B            | C | D |            E             | F | G |H                | I | J | K | L | M |
+---+--------------------------+---+---+--------------------------+---+---+-----------------+---+---+---+---+---+
| 5 |Instrumento de Corto Plazo| 4 | 1 |Instrumento de Corto Plazo| 3 | 3 |Bono Corporativo | 1 | 1 | 3 | 4 | 6 |
+---+--------------------------+---+---+--------------------------+---+---+-----------------+---+---+---+---+---+

我已经处理了以下代码，但它们根本不起作用：

Sub abv_to_full()

If InStr(1, Cells(a, 5), "Corp", 1) Or InStr(1, Cells(a, 5), "BC", 1) Then
Cells(a, 5).Offset(0, 1).Value = "Bonos Corporativos" 'English: corporate bonds

ElseIf InStr(1, Cells(a, 5), "C.D.N.", 1) Or InStr(1, Cells(a, 5), "CDN", 1) Then
Cells(a, 5).Offset(0, 1).Value = "Certificados de Depositos" 'English: certificates of deposits / term deposits

ElseIf InStr(1, Cells(a, 5), "I.C.P", 1) Or InStr(1, Cells(a, 5), "ICP", 1) Then
Cells(a, 5).Offset(0, 1).Value = "Instrumentos de Corto Plazo" 'English: short term instruments

ElseIf InStr(1, Cells(a, 5), "BS", 1) Or InStr(1, Cells(a, 5), "Subo", 1) Then
Cells(a, 5).Offset(0, 1).Value = "Bonos Subordinados" 'English: Subordinated Bonds

ElseIf InStr(1, Cells(a, 5), "BAF", 1) Or InStr(1, Cells(a, 5), "B.A.F.", 1) Then
Cells(a, 5).Offset(0, 1).Value = "Bonos de Arrendamiento Financiero" 'English: financial lease bonds

ElseIf InStr(1, Cells(a, 5), "BH", 1) Or InStr(1, Cells(a, 5), "BHIP", 1) Then
Cells(a, 5).Offset(0, 1).Value = "Bonos Hipotecarios" 'English: mortgage securities

ElseIf InStr(1, Cells(a, 5), "IRD", 1) Then
Cells(a, 5).Offset(0, 1).Value = "Instrumentos Representativos de Deuda" 'English: instruments representing debt

End If

End Sub

Sub second_try()
Dim start_, startp_ As Integer
Dim ant_tipo, nvo_tipo

ant_tipo = Array("Corp", "BC", "C.D.N.", "CDN", "I.C.P.", "ICP", "BS", "Subo", "BAF", "B.A.F.", "IRD", "BHIP", "BH")
nvo_tipo = Array("Bonos Corporativos", "Bonos Corporativos", "Certificados de Deposito", "Certificados de Deposito", "Instrumentos de Corto Plazo", "Instrumentos de Corto Plazo", "Bonos Subordinados", "Bonos Subordinados", "Bonos de Arrendamiento Financiero", "Bonos de Arrendamiento Financiero", "Instrumentos Representativos de Deuda", "Bonos Hipotecarios", "Bonos Hipotecarios")

cont = 0
Start = 1
Do
pos = InStr(Start, Cells(a, 5), ant_tipo(i), 0)
    If pos > 0 Then
      Start = pos + 1  'alternatively: start = pos + Len(srch)
      Cells(a, 5).Offset(0, 2 + cont).Value = nvo_tipo(i)
      cont = cont + 1
    End If
    On Error Resume Next
Loop While pos > 0
End sub

Answer 1

托盘此代码。 （内有评论）

   Sub Break_String()
        Dim sarray() As String
        Dim stemp As String
        Dim ant_tipo, nvo_tipo
        Dim rcell As Range
        Dim icounter As Integer
        'yuo must add also value for "I.C.P"
        ant_tipo = Array("Corp", "BC", "C.D.N.", "CDN", "I.C.P", "I.C.P.", "ICP", "BS", "Subo", "BAF", "B.A.F.", "IRD", "BHIP", "BH")
        nvo_tipo = Array("Bonos Corporativos", "Bonos Corporativos", "Certificados de Deposito", "Certificados de Deposito", "Instrumentos de Corto Plazo", "Instrumentos de Corto Plazo", "Instrumentos de Corto Plazo", "Bonos Subordinados", "Bonos Subordinados", "Bonos de Arrendamiento Financiero", "Bonos de Arrendamiento Financiero", "Instrumentos Representativos de Deuda", "Bonos Hipotecarios", "Bonos Hipotecarios")

        'loop for all data cells
        For c = 1 To Cells(1, 1).CurrentRegion.Rows.Count

            Set rcell = Cells(c, 1)
            stemp = rcell.Value

            'replace , and - and y on space
            'prevents any missing spaces between data
            stemp = Replace(stemp, ",", " ")
            stemp = Replace(stemp, "-", " ")
            stemp = Replace(stemp, "y", " ")
            icounter = 1 'used for select first empty cell in a row
            'split using space
            sarray() = Split(stemp)

            For i = LBound(sarray) To UBound(sarray)
            'Delete spaces
                stemp = Trim(sarray(i))
            'check if name
                For j = LBound(ant_tipo) To UBound(ant_tipo)
                    If InStr(stemp, ant_tipo(j)) Then
                        rcell.Offset(0, icounter).Value = nvo_tipo(j)
                        icounter = icounter + 1
                        Exit For
                    End If
                Next j
            'assign values for P and E
            'check if the fisrt sign is a number to eliminate company names
            If InStr("123456789", Left(stemp, 1)) Then
                If Right(stemp, 1) = "P" Or Right(stemp, 1) = "E" Then
                    rcell.Offset(0, icounter).Value = Mid(stemp, 1, Len(stemp) - 1)
                    icounter = icounter + 1
                End If
             End If
            Next i
        Next c
    End Sub