vba - 连接列(用户选择)并将其替换为新列

Question

我不是高级 VBA 程序员。我正在开发一个 Excel 宏，它允许我选择一个范围(使用输入框)​​来清理工作表上的数据(与 mySQL 架构一致)。我从花药团队获得此文件，

1.) 列的顺序不固定

2) 类别级别(类别很少有列，例如 level1 level2 等)可以是 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 数据库之前，我必须对文件执行此操作，因此宏会很方便。请询问我是否没有提及其他内容。

编辑:附加图像用于说明

更新:现在，在 mrexcel 上 vaskov17 的帮助下，我有了一个工作代码，但它不会删除选择级别(级别 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