Excel VBA合并单元格值

Question

我有一个宏，我将文本转换为列，以便我可以使用我的PDF文件中的数据。

虽然它运作得很好，但我想知道它是否可以开发。 我的数据看起来像这样：

Invoice    10-12-2017 USD        400,00  
Creditmemo 18-12-2017 USD        205,60  
Invoice    27-12-2017 USD        906,75  
Invoice    29-12,2017 USD        855,00  
Interest   I12391     31-12-2017 USD    105

正如您从上面可能看到的那样，“兴趣”行有一个额外的数字，这可以防止数据正确对齐。

我希望它看起来更像这样：

[Invoice]               10-12-2017 USD    400,00  
[Creditmemo]            18-12-2017 USD    205,60  
[Invoice]               27-12-2017 USD    906,75  
[Invoice]               29-12,2017 USD    855,00  
[Interest I12391]       31-12-2017 USD       105

到目前为止我所拥有的：

我的代码是这个atm：

rng1 = Range("A3:A750")

Range(rng1).TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True

目标：

我希望代码遍历我的数据，每当它找到“兴趣”时，它应该复制数字并在“兴趣”之后插入它。他们应该合并而不是两个不同的单元格，而是成为“兴趣I12391”。然后数据将被正确地分配，因为“兴趣”行比其他行有一个额外的行

我应该对“兴趣”执行.Find.Address，并重复使用.Offset（0,1）的公式并合并这两个？或者有更简单，更有效的方法吗？

除了主要问题之外......我是否可以使用Range.TextToColums，因此它只影响我需要的工作表，而不是整个工作簿？

Answer 1

您能否尝试使用以下方法，看看它是否给您带来任何成功？要使用它，请选择包含您要修复的数据的单元格，然后运行此子例程：

Public Sub dataFixer()
    Dim selectedDataRange() As Variant
    Dim selectedRow() As Variant
    Dim numberOfRowsInSelection As Integer
    Dim numberOfColsInSelection As Integer

    selectedDataRange = Selection 'Makes a 2D array from the user's selected range.
    numberOfRowsInSelection = UBound(selectedDataRange, 1)
    numberOfColsInSelection = UBound(selectedDataRange, 2)

    For i = 1 To numberOfRowsInSelection
        selectedRow = Application.Index(selectedDataRange, i, 0)     'Selects row i of the selectedDataRange
        If selectedRow(1) = "Interest" Then                          'If the first item in the row is "Interest" then...
            selectedRow(1) = selectedRow(1) & " " & selectedRow(2)   '...combine the first and second item
            For j = 2 To numberOfColsInSelection - 1
                selectedRow(j) = selectedRow(j + 1)                  '...and proceed to shift other items in the row to the left
            Next
        End If
        Selection.Rows(i) = selectedRow                              'Finally, "paste" the selected row to the corresponding row in the user's selected range
    Next                                                             'Proceed to the next row in the 2D array
End Sub

Answer 2

谢谢您的回答。我设法制作了一个字符串，它解决了问题...

Dim sht As Worksheet
Dim rng9, rng10, c, Rw As Range
Set sht = Sheets("Kvik Kontoudtog")
Set rng9 = sht.Range(FindDescripOffset, DescripSub2)

    For Each c In rng9.Cells
        If c = "Rente" Then
        CValue = c.Address(False, False, xlA1)
        CValueOffset = Range(CValue).Offset(0, 1).Address(False, False, xlA1)
        Range(CValue).Value = Range(CValue).Value & " " & Range(CValueOffset).Value
        Range(CValueOffset).Delete Shift:=xlToLeft
        End If
    Next c