如何跨多行多列连接数据和删除列？答案

【问题标题】：How to concatenate data and delete columns across multiple rows and columns?如何跨多行多列连接数据和删除列？
【发布时间】：2013-02-28 18:31:19
【问题描述】：

我有一个宏，用于检查字符串“Doc1”和“Doc2”是否出现在第一行（标题）的连续列中。
然后，对于所有后续行，宏应将 Doc1 列中的信息与 Doc2 列中的信息连接起来，并用逗号分隔响应。然后它应该删除整个 Doc2 列。
使用我拥有的代码，这适用于并排的 Doc1 和 Doc2 的第一个实例。对于其余部分，它只是删除 Doc2 列，而不将信息连接到 Doc1 框中。对此的任何帮助将不胜感激。

这里是代码：

Sub test()

Dim CurrCol As Integer
Dim NewValue As String
Dim CurrRow As Integer

CurrCol = 1
RowNum = 1

'set last cell
While Cells(1, CurrCol).Address <> "$HOK$1"

    'MsgBox Cells(1, CurrCol).Address & " " & Cells(1, CurrCol).Value

        If InStr(Cells(1, CurrCol).Value, "Doc1") > 0 Then
            ' look at next cell
            If InStr(Cells(1, CurrCol + 1).Value, "Doc2") > 0 Then
                For i = RowNum + 1 To 10
                    If Trim(Cells(RowNum + 1, CurrCol + 1).Value) <> "" Then
                        NewValue = Cells(RowNum + 1, CurrCol).Value & ", " & Cells(RowNum + 1, CurrCol + 1).Value
                    '   MsgBox "New Value is " & NewValue
                        Cells(RowNum + 1, CurrCol).Value = NewValue
                        RowNum = RowNum + 1
                    End If

                Next


            End If

            'now delete currCol+1
            Range(Columns(CurrCol + 1), Columns(CurrCol + 1)).Select
            Selection.Delete Shift:=xlToLeft

        End If


    'Advance the counter
    CurrCol = CurrCol + 1
Wend

End Sub

【问题讨论】：

标签： excel vba iteration concatenation

【解决方案1】：

您遇到的问题似乎与RowNum = RowNum + 1 行有关。此行是不必要的，并导致您的 RowNum 变量在第一列之后关闭。相反，使用 i 变量来引用您当前所在的行。如果您只想从第 2 行循环到第 10 行（看起来就是这种情况），则需要进行以下调整：

改变这个：

If InStr(Cells(1, CurrCol + 1).Value, "Doc2") > 0 Then
    For i = RowNum + 1 To 10
        If Trim(Cells(RowNum + 1, CurrCol + 1).Value) <> "" Then
            NewValue = Cells(RowNum + 1, CurrCol).Value & ", " & Cells(RowNum + 1, CurrCol + 1).Value
        '   MsgBox "New Value is " & NewValue
            Cells(RowNum + 1, CurrCol).Value = NewValue
            RowNum = RowNum + 1
        End If

    Next

End If

到这里：

If InStr(Cells(1, CurrCol + 1).Value, "Doc2") > 0 Then
    For i = 2 To 10
        If Trim(Cells(i, CurrCol + 1).Value) <> "" Then
            NewValue = Cells(i, CurrCol).Value & ", " & Cells(i, CurrCol + 1).Value
        '   MsgBox "New Value is " & NewValue
            Cells(i, CurrCol).Value = NewValue
        End If
    Next i
End If

【讨论】：

@user2108977 点击我的答案旁边的复选框。