Excel VBA合并单元格值答案

【问题标题】：Excel VBA merging cell valuesExcel VBA合并单元格值
【发布时间】：2017-12-22 13:19:17
【问题描述】：

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

【问题讨论】：

您需要将列"A" 和"B" 的值连接起来，将它们放在"A" 列中，删除利息号 单元格，对吗？ "B" 列的格式是什么？
问题是我只需要合并列“A”和“B”的单元格，只要出现“兴趣”这个词，而不是整个列。我很抱歉在上面解释得很糟糕:) B 列是“日期”格式，但是每当它到达带有“兴趣”的行时，格式就会变为一般格式，因为没有日期。由于数据是从 PDF 文件中获取的，因此它用空格分隔文本。但它不应该将“兴趣”和“I12391”分开。
你有列标题吗？
我的列标题是：A = 描述 B = 到期日 C = 货币 D = 金额
你已经添加了一个VBA标签，你有没有在VBA中尝试过什么？此外，您的描述与您实际要求的不符......只是好奇它们是如何联系起来的？我建议将FORMULA 和VBA 组合使用，但也有点困惑，因为您正在寻找什么样的帮助

标签： vba excel find text-to-column

【解决方案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

【讨论】：

【解决方案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

【讨论】：