连接列(用户select)并将其replace为新列

我不是一个先进的VBA程序员。 我正在处理一个Excelmacros,这将允许我select一个范围(使用input框)​​清理工作表上的数据(与mySQL模式保持一致)。 我从另一个团队获得这个文件

1.)列的顺序不固定

2)类别的级别(像level1 level2等类别只有几列)可以是3-10之间的任何东西。

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

我从最后删除了一些代码,以减less在这里的长度,但它仍然是有道理的:

 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 

插图 请不要build议UDF,我想用macros做这个。 在将数据导入到SQL数据库之前,我必须对这些文件执行此操作,因此macros将很方便。 请问我是否没有提到别的。

编辑:图像附加说明

更新:我现在有一个工作代码在mrexcel上vaskov17的帮助,但它不会删除从哪里级挑选的列 – 级别2,级别3 …等。 将下一列向左移动,对我来说主要的挑战是在现有的macros中使用范围types而不是长types实现该代码。 我不想单独input起始栏和结束栏,而是应该可以select与原始macros一样的范围。 该macros的代码如下,请帮助我:

 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 

我已经删除了用于select类别列的input框。 由于它们始终被命名为Level x » y因此可以更轻松地自动find它们。 这就是为什么添加一个FindColumns() Sub到你的代码。 它将第一个fCol和最后一个lCol类别列分配给全局variables。

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