Vba 如何从Excel中大小不同的表中删除特定值

我是这个社区的新手，如果其他地方有帖子，我很抱歉，但我找不到

我目前第一次潜入VBA编码。我有一个文件，我转储到一个工作表，目前我正在手动组织和推出。当放入工作表时，它会在单元格之间划界。每次我在给定的一天内得到这个转储文件并将其转储到工作表中时，它的行和列长度都会发生变化。例如，一天可能是二十行，一天可能是三十行

我的VBA代码创建过程中出现了一个障碍。我正在尝试创建一个代码，该代码将在工作表中进行解析，以便在出现某个值时删除该值（请参见下图-我指的是（EXT））。在这样做之后，我将尝试将行中的单元格连接起来，直到有一个空格（其中包含有（EXT）的行，在删除（EXT）之前，后面通常没有空格）

我编写的代码目前还可以工作，但我认识到，如果名称扩展超过两个单元格，它的效率不高，也不可靠。我希望这里有人能给我提供指导。所以，我要找两件事：

• 用于扫描表格的整个活动使用范围并删除（EXT）的代码。它可能出现在不同的栏目中
• 将活动范围内每行中的单元格从A连接到空白单元格之前的单元格的方法

请记住，我没有编码背景，我正在学习，我还不熟悉VBA术语等等，所以如果你能用外行的术语解释一下，我将不胜感激。我希望这一切都有意义。。。提前谢谢

这只是转储代码外观的一部分示例，因此我的代码可能与下面的示例不匹配-我只是想提供一个视觉效果：

我目前拥有的代码：

Sub DN_ERROR_ORGANIZER()

' Removes any (EXT) in Column 3 in actual dump data file
For i = 200 To 1 Step -1
   If (Cells(i, 3).value = "(EXT)") Then
   Cells(i, 3).Delete Shift:=xlToLeft
   End If
Next i

' Removes any (EXT) in Column 4 in actual dump data file
For j = 200 To 1 Step -1
   If (Cells(j, 4).value = "(EXT)") Then
   Cells(j, 4).Delete Shift:=xlToLeft
   End If
Next j

' Removes any (EXT) in Column 5 in actual dump data file
For k = 200 To 1 Step -1
   If (Cells(k, 5).value = "(EXT)") Then
   Cells(k, 5).Delete Shift:=xlToLeft
   End If
Next k

' Places a new column before A and performs a concatenate on cells B1 and C1 to
' form a name, then copies all through column A1 to repeat on each row
   Columns("A:A").Select
   Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
   Range("A1").Select
   ActiveCell.FormulaR1C1 = "=PROPER(CONCATENATE(RC[1],"", "", RC[2]))"
   Range("A1").Select
   Selection.AutoFill Destination:=Range("A1:A51")
   Range("A1:A51").Select

End Sub

---

我相信你很快就能实现你的要求，根据你的要求，我不会给你一个解决方案，而是给你一些指导，让你自己完成

前3个循环：您可以通过使用一组嵌套循环来简化：外部循环从3到5，内部循环从200到1；外部循环将遍历索引，称为“p”，内部循环遍历索引，称为“q”，您对单元格的引用将变成

单元格（q，p）

。如果需要在3行以上运行此操作，只需从3开始执行外部循环，直到10000（10000是数据可能显示的最大行数），并添加一个条件，即如果行的第一个单元格为空，则退出外部循环

第二部分（这就是我所理解的）是将前2-3个单元格连接成一个新单元格（即您在左侧添加的列）。同样，您可以在所有行上循环（与上面提到的外部循环基本相同），只是现在您将看到第2-4列中的单元格（因为您在左侧添加了一列）。可以使用与上述相同的退出条件

---

我不确定这是否是您要找的，但我知道您要找的就是这个。

编辑：仅在第一个“名称”后保留逗号

这应该做到：

Sub main()
    Dim cell As Range

    With Worksheets("names")
        With Intersect(.UsedRange, .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).EntireRow)
            For Each cell In .Rows
                cell.Cells(1, 2).Value = Replace(Replace(Replace(Join(Application.Transpose(Application.Transpose(cell.Value)), " "), "  ", " "), " (EXT)", ""), " ", ", ", , 1)
            Next cell
            .Columns(1).FormulaR1C1 = "=PROPER(RC[1])"
            .Columns(1).Value = .Columns(1).Value
            .Offset(, 1).Resize(, .Columns.Count - 1).ClearContents
        End With
    End With
End Sub

请记住将“名称”更改为实际工作表名称

编辑2: 用于在第一个空白单元格之前的最后一行的每一行停止要处理的单元格的代码

Sub main()
    Dim cell As Range, dataRng As Range

    With Worksheets("names") '<--| change "names" to you actual worksheet name
        Set dataRng = Intersect(.UsedRange, .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).EntireRow)
        For Each cell In dataRng.Columns(1).Cells
            cell.Offset(, 1).Value = Replace(Replace(Replace(Join(Application.Transpose(Application.Transpose(.Range(cell, cell.End(xlToRight)).Value)), " "), "  ", " "), " (EXT)", ""), " ", ", ", , 1)
        Next cell
        With dataRng
            .Columns(1).FormulaR1C1 = "=PROPER(RC[1])"
            .Columns(1).Value = .Columns(1).Value
            .Offset(, 1).Resize(, .Columns.Count - 1).ClearContents
        End With
    End With
End Sub

Sub-main（）
变暗单元格作为范围，数据标记作为范围
在阅读了user3598756的答案后，我意识到我错过了原来的答案

Sub DN_ERROR_ORGANIZER()
    Dim Target As Range
    Set Target = Worksheets("Sheet1").UsedRange
    Target.Replace "(EXT)", ""
    With Target.Offset(0, Target.Columns.Count).Resize(, 1)
        .FormulaR1C1 = "=PROPER(C1&"", ""&TEXTJOIN("" "",TRUE,RC[-" & (Target.Columns.Count - 1) & "]:RC[-1]))"
        .Value = .Value
    End With

    Target.Delete
End Sub

更新
如果您运行的是不支持
TEXTJOIN
的旧版本Excel，请使用以下方法：


子DN\u错误\u管理器（）
模糊数据
尺寸x和长度一样，y和长度一样
作为射程的弱小目标
将文本变暗为字符串
设置目标=工作表（“表1”）。使用范围
目标。替换“（外部）”，“”
数据=目标值
对于x=1到Target.Rows.Count
数据（x，1）=数据（x，1）
对于y=2到Target.Columns.Count
如果数据（x，y）为空字符串，则Text=Text&&&Data（x，y）
下一个
如果Len（Text），那么Data（x，1）=Data（x，1）&“，”和Text
Text=vbNullString
下一个
Target.ClearContents
Target.Columns（1）.Value=数据
端接头
干得好+1。我的新答案是根据你的答案得出的。我认为OP只需要在姓氏（第一列值）后加一个逗号。@ThomasInzina，你说得对，进行了相应的编辑。thanks@ThomasInzina非常感谢你们提供代码。不幸的是，托马斯，你的名字不起作用了，你给他起了个#名字？在每行的末尾。对于您的用户3598756，它可以工作，但会连接整行数据。有没有一种方法可以让它只在第一次出现空白单元格之前进行连接？在我的原始转储数据中，它将包含我正在格式化的其他数据。我希望这有意义？ahaha@lejaregg别担心。我忘了TestJoin是一个新函数，并没有广泛使用。快乐编码@user3598756：我已经试着去除你的代码，但对我来说，一开始就相当复杂。我已经试过了，但是我不知道如何进行连接。我希望它获取行中的第一个单元格，用“，”连接，然后继续连接行中的单元格，直到它遇到该行中的空白单元格，然后转换到下一行，并执行相同的操作，直到到达最后一行。托马斯：如果你有意见的话，绝对欢迎！
Sub DN_ERROR_ORGANIZER()
    Dim Data
    Dim x As Long, y As Long
    Dim Target As Range
    Dim Text As String
    Set Target = Worksheets("Sheet1").UsedRange
    Target.Replace "(EXT)", ""
    Data = Target.Value

    For x = 1 To Target.Rows.Count
        Data(x, 1) = Data(x, 1)
        For y = 2 To Target.Columns.Count
            If Data(x, y) <> vbNullString Then Text = Text & " " & Data(x, y)
        Next
        If Len(Text) Then Data(x, 1) = Data(x, 1) & "," & Text
        Text = vbNullString
    Next
    Target.ClearContents
    Target.Columns(1).Value = Data
End Sub