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

目標：

我希望代碼循環遍歷我的數據，只要找到“ Interest”，它就應該復制該數字並將其插入“ Interest”之后。 它們應該合並而不是成為兩個不同的單元，並成為“ Interest I12391”。 然后，數據將正確分配，因為“興趣”行比其他行多了一行

我應該在“ Interest”上執行.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