连接列(用户选择)并用新列替换它们

时间:2013-08-27 12:52:32

标签: excel vba excel-vba

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

1。)列的顺序不固定

2)类别级别(如level1 level2等类别的列数很少)可以是3-10之间的任何值。

我希望使用|作为分隔符连接类别的列(在图像级别1,级别2等),并将值放在第一个类别列(level1)中,同时删除剩余的列(级别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

Illustration 请不要建议使用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

1 个答案:

答案 0 :(得分:2)

我删除了输入框以选择类别列。由于它们始终命名为级别x»y,因此可以更轻松地自动查找它们。这就是为什么在您的代码中添加FindColumns() Sub的原因。它将第一个fCol和最后一个lCol类别列分配给全局变量。

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

DeleteColumns()删除其他列

Cells(1, fCol).Value = "CategoryLevel 1重命名为CategoryColumns.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