连接列（用户选择）并用新列替换它们

Question

我不是高级 VBA 程序员。我正在研究一个 excel 宏，它允许我选择一个范围（使用输入框）​​来清理工作表上的数据（与 mySQL 模式一致）。我从另一个团队得到这个文件，并且

1.) 列的顺序不固定

2) 类别级别（级别1 级别2 等类别的列很少）可以是3-10 之间的任何值。

我想使用| 作为分隔符连接类别的列（在图像级别 1、级别 2 等中），并将值放在第一个类别列（级别 1）中，同时删除剩余的列（级别 2、级别 3 ...[10级]）。

我从末尾删除了一些代码以减少这里的长度，但它仍然有意义：

Sub cleanData()
Dim rngMyrange As Range
Dim cell As Range
On Error Resume Next
    Do
        'Cleans Status column
        Set rngMyrange = Application.InputBox _
            (Prompt:="Select Status column", Type:=8)
            On Error GoTo 0
            'Is a range selected? Exit sub if not selected
            If rngMyrange Is Nothing Then
                End
                Else
                Exit Do
            End If
    Loop
        With rngMyrange 'with the range just selected
            .Replace What:="Dead", Replacement:="Inactive", SearchOrder:=xlByColumns, MatchCase:=False
            'I do more replace stuff here
        End With
    rngMyrange.Cells(1, 1) = "Status"

Do
        'Concatenates Category Columns
        Set rngMyrange = Application.InputBox _
            (Prompt:="Select category columns", Type:=8)
            On Error GoTo 0
            'Is a range selected? Exit sub if not selected
            If rngMyrange Is Nothing Then
                End
                Else
                Exit Do
            End If
    Loop
        With rngMyrange 'with the range just selected
            'Need to concatenate the selected columns(row wise)
        End With
    rngMyrange.Cells(1, 1) = "Categories"
End Sub

请不要建议 UDF，我想用宏来做这个。在将文件导入 SQL 数据库之前，我必须对文件执行此操作，因此宏会很方便。请问我是否没有提及其他内容。

编辑：附上图片用于说明

更新： 我现在在 vaskov17 的帮助下在 mrexcel 上有一个工作代码，但它不会删除从中选择级别的列 - 级别 2、级别 3 ......等。将下一列向左移动，对我来说主要挑战是使用范围类型而不是长类型在我现有的宏中实现该代码。我不想分别输入开始列和结束列，而是应该能够像在原始宏中一样选择范围。该宏的代码如下，请帮助我：

Sub Main()
    Dim start As Long
    Dim finish As Long
    Dim c As Long
    Dim r As Long
    Dim txt As String

    start = InputBox("Enter start column:")
    finish = InputBox("Enter ending column:")

    For r = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        For c = start To finish
            If Cells(r, c).Text <> "" Then
                txt = txt & Cells(r, c).Text & "|"
                Cells(r, c).Clear
            End If
        Next

        If Right(txt, 1) = "|" Then
            txt = Left(txt, Len(txt) - 1)
        End If

        Cells(r, start) = txt
        txt = ""
    Next

End Sub

Answer 1

我已删除用于选择类别列的输入框。由于它们始终被命名为 Level x»y，因此更容易自动找到它们。这就是为什么在您的代码中添加 FindColumns() Sub 的原因。它将第一个fCol 和最后一个lCol 类别列分配给全局变量。

ConcatenateColumns() 使用“|”连接每行中的单元格作为分隔符。

DeleteColumns() 删除其他列

Cells(1, fCol).Value = "Category 将 Level 1 重命名为 Category 和 Columns.AutoFit 调整所有列的宽度以适合文本。

代码：

Option Explicit

Dim fCol As Long, lCol As Long

Sub cleanData()
    Dim rngMyrange As Range
    Dim cell As Range
    On Error Resume Next
        Do
            'Cleans Status column
            Set rngMyrange = Application.InputBox _
                (Prompt:="Select Status column", Type:=8)
                On Error GoTo 0
                'Is a range selected? Exit sub if not selected
                If rngMyrange Is Nothing Then
                    End
                    Else
                    Exit Do
                End If
        Loop
            With rngMyrange 'with the range just selected
                .Replace What:="Dead", Replacement:="Inactive", SearchOrder:=xlByColumns, MatchCase:=False
                'I do more replace stuff here
            End With
        rngMyrange.Cells(1, 1) = "Status"

        ' Concatenate Category Columns
        FindColumns
        ConcatenateColumns
        DeleteColumns

        Cells(1, fCol).Value = "Category"
        Columns.AutoFit
End Sub

Private Sub FindColumns()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    Dim i As Long, j As Long
    For i = 1 To ws.Cells(1, Columns.Count).End(xlToLeft).Column
        If StrComp(ws.Cells(1, i).Text, "Level 1", vbTextCompare) = 0 Then
            For j = i To ws.Cells(1, Columns.Count).End(xlToLeft).Column
                If InStr(1, ws.Cells(1, j).Text, "Level", vbTextCompare) Then
                    lCol = j
                End If
            Next j
            fCol = i
            Exit Sub
        End If
    Next i
End Sub

Private Sub ConcatenateColumns()
    Dim rng As Range
    Dim i As Long, j As Long
    For i = 2 To Cells(Rows.Count, fCol).End(xlUp).Row
        Set rng = Cells(i, fCol)
        For j = fCol + 1 To lCol
            rng = rng & "|" & Cells(i, j)
        Next j
        rng = "|" & rng & "|"
        Set rng = Nothing
    Next i
End Sub

Private Sub DeleteColumns()
    Dim i As Long
    For i = lCol To fCol + 1 Step -1
        Columns(i).Delete Shift:=xlToLeft
    Next i
End Sub