Excel VBA合并单元格值

Posted 2021-04-14

我有一个宏，我将文本转换为列，以便我可以使用我的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，因此它只影响我需要的工作表，而不是整个工作簿？

答案

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

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

另一答案

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

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