我正在建立主要市场中公司债务问题的历史数据排除。
我需要宏
读取每个单元格并检查其是否包含许多的缩写 选项，并根据缩写将完整值复制到 同一行的下一个空单元格。
将对应的先前字符串值复制到“ P” 在项目符号1中找到的缩写，位于同一行的下一个empy单元格中。
将在以下位置找到的对应“ P”的所有先前字符串值复制到“ E” 项目符号1的下一个empy单元格中的项目符号2和缩写 同一行。
对于所有在单元格中找到的缩写重复此操作。
+---+--------------------------------------------------------------------+
| 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
答案 0 :(得分：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