Question

我是社区的新手，如果其他地方有线索，我道歉，但我找不到了！

我目前第一次潜入VBA编码。我有一个文件，我转储到工作表中，目前我手动组织和推出。放入工作表时，它会跨单元格划分自己。每次我在给定的日期获取它并转储到工作表中时，此转储文件将具有不同的行和列长度。例如，有一天它可能是二十行，一天它可能是三十。

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

我制作的代码现在可以使用，但我认识到如果名称的扩展时间超过两个单元格，它的效率和效率都不高。我希望这里有人可以为我提供指导。所以，我正在寻找两件事：

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

请记住，我没有编码背景，我正在学习，而且我不熟悉VBA术语，还有那么多 - 所以如果你能用外行的话来解释我很感激。我希望所有这一切都有意义......提前谢谢！

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

http://i.imgur.com/IwDDoYd.jpg

我目前的代码：

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

Answer 1

已修改：将逗号保留在第一个＆＃34; name＆＃34;之后仅

这应该做：

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

请记住改变名字＆＃34;给你实际的工作表名称

已编辑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

Answer 2

我相信你已经非常接近实现你的要求，并且根据你的要求，我不会给你一个解决方案，而是一些指导你自己完成它。

前三个循环：你可以通过一组嵌套循环来简化：一个从3到5运行的外循环，一个从200运行到1的内循环;外部循环将在索引上运行，比如“p”，内部过度索引，比如说“q”，并且您对单元格的引用将变为Cells(q,p)。如果你需要超过3行运行它，只需从3开始外循环，直到说10000（数据可能显示的最大行数为10000）并添加条件，如果第一个单元格为该行为空，退出外循环。
第二部分（这是我所理解的）是取2-3个第一个单元格并将它们连接成一个新单元格（即你在左边添加的列）。再次，您可以循环遍历所有行（与上面提到的外部循环非常相似），除了现在您将查看列2-4中的单元格（因为您在左侧添加了一列）。可以使用与上述相同的退出条件。

我不确定这是否是您所寻找的，但这是我理解您正在寻找的。

Answer 3

在阅读了用户3598756的回答之后，我意识到我错过了原来的答案。

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，请使用此功能：

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

如何从Excel中删除大小不同的表中的某个值

3 个答案:

更新