优化Excel VBA代码 – 结合居民地址

我在Excel中完成了以下2个VBA代码。 主要目的是将多个地址行组合成一行。 问题是需要永远运行。 有反正我可以优化它吗？

数据是这样的，每个客户地址都有一个case＃。 客户地址可以分成多行。 示例：“地址行1 – 块56”，“地址行2 – Parry Avenue”，“地址行3 – 邮政编码”。 每个新地址之间都有一个空格。

我的目的是将地址组合成一行，并删除案件编号之间的空行，例如“Block 56 Parry Avenue邮政编码”。 有大约26K箱号码。

Sub test() Dim l As Long Dim lEnd As Long Dim wks As Worksheet Dim temp As String Application.EnableEvents = False Application.ScreenUpdating = False Set wks = Sheets("data") wks.Activate lEnd = ActiveSheet.UsedRange.Rows.Count For l = 3 To lEnd If Not IsEmpty(Cells(l, 1)) Then Do Until IsEmpty(Cells(l + 1, 4)) temp = Cells(l, 4).Value & " " & Cells(l + 1, 4).Value Cells(l, 4).Value = temp Cells(l + 1, 4).EntireRow.Delete Loop Else: Cells(l, 1).EntireRow.Delete Do Until IsEmpty(Cells(l + 1, 4)) temp = Cells(l, 4).Value & " " & Cells(l + 1, 4).Value Cells(l, 4).Value = temp Cells(l + 1, 4).EntireRow.Delete Loop End If Next l End Sub 

和我试过的第二个代码

 Sub transformdata() ' Dim temp As String Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Range("A3").Select Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0)) Do Until IsEmpty(ActiveCell.Offset(1, 3)) temp = ActiveCell.Offset(, 3).Value & " " & ActiveCell.Offset(1, 3).Value ActiveCell.Offset(, 3).Value = temp ActiveCell.Offset(1, 3).EntireRow.Delete Loop ActiveCell.Offset(1, 0).EntireRow.Delete ActiveCell.Offset(1, 0).Select Loop Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub 

Answer 1

1. 更改行lEnd = ActiveSheet.UsedRange.Rows.Count 。 错误的方式find最后一行。 你可能想看到这个
2. 要删除Cells(l, 1)为空的行，请使用自动筛选器。 看到这个
3. 不要直接删除行。 使用一个反向循环。 或者你可以做的是确定你想在循环中删除的单元格，然后在循环之后一次删除它们。 你可能想看到这个

这是一个基本的例子。

假设你的工作表看起来像这样

如果你运行这个代码

 Sub test() Dim wks As Worksheet Dim lRow As Long, i As Long Dim temp As String Application.ScreenUpdating = False Set wks = Sheets("data") With wks '~~> Find Last Row lRow = .Range("C" & .Rows.Count).End(xlUp).Row For i = lRow To 2 Step -1 If Len(Trim(.Range("C" & i).Value)) <> 0 Then If temp = "" Then temp = .Range("C" & i).Value Else temp = .Range("C" & i).Value & "," & temp End If Else .Range("D" & i + 1).Value = temp temp = "" End If Next i End With End Sub 

你会得到这个输出

现在只需运行autofilter删除列D空的行:)我已经给你上面的链接相同。

Answer 2

下面的代码将所有的数据复制到一个数组，合并它，并将其添加到一个新的工作表。 您需要使COLUMNCOUNT =包含数据的列数。

 Sub TransformData2() Const COLUMNCOUNT = 4 Dim SourceData, NewData Dim count As Long, x1 As Long, x2 As Long, y As Long SourceData = Range("A" & Range("D" & Rows.count).End(xlUp).Row, Cells(3, COLUMNCOUNT)) For x1 = 1 To UBound(SourceData, 1) count = count + 1 If count = 1 Then ReDim NewData(1 To 4, 1 To count) Else ReDim Preserve NewData(1 To 4, 1 To count) End If For y = 1 To UBound(SourceData, 2) NewData(y, count) = SourceData(x1, y) Next x2 = x1 + 1 Do NewData(4, count) = NewData(4, count) & " " & SourceData(x2, 4) x2 = x2 + 1 If x2 > UBound(SourceData, 1) Then Exit Do Loop Until IsEmpty(SourceData(x2, 4)) x1 = x2 Next ThisWorkbook.Worksheets.Add Range("A1").Resize(UBound(NewData, 2), UBound(NewData, 1)).Value = WorksheetFunction.Transpose(NewData) End Sub