Question

这是我在该论坛上的第一篇帖子，我很高兴找到它。我已经使用了网站上的许多技巧来帮助我进行项目，我称自己是初学者级VBA开发人员。

我创建了一个循环，该循环可以导出数据以进行进一步的过滤，它的工作原理很完美，但是非常长。有什么方法可以使下面的代码更短，更令人愉悦并保持功能？

有关代码及其作用的简短说明：

它从一个电子表格中导出数据，该电子表格具有以某种模式组织的数据，但是这种模式不允许我使用过滤器，因此我创建了导出宏来破坏该模式并将数据放入列中。

在此先感谢您的帮助或建议。

'export
Dim rownumber As Double
rownumber = 2

Rev.Activate
Rev.Range("A13").Select

Do Until IsEmpty(ActiveCell.Offset(4, 0))

Exp.Range("A" & rownumber).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 1).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 2).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 3).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 4).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 5).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 6).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 7).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 8).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 9).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 10).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 11).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 12).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 13).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 14).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 15).Value = ActiveCell.Value
Exp.Range("A" & rownumber + 16).Value = ActiveCell.Value


Exp.Range("A" & rownumber).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 1).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 2).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 3).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 4).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 5).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 6).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 7).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 8).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 9).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 10).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 11).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 12).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 13).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 14).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 15).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("A" & rownumber + 16).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color

Exp.Range("B" & rownumber).Value = "Q1"
Exp.Range("B" & rownumber + 1).Value = "Q2"
Exp.Range("B" & rownumber + 2).Value = "Q3"
Exp.Range("B" & rownumber + 3).Value = "Q4"
Exp.Range("B" & rownumber + 4).Value = "A"
Exp.Range("B" & rownumber + 5).Value = "Jan"
Exp.Range("B" & rownumber + 6).Value = "Feb"
Exp.Range("B" & rownumber + 7).Value = "Mar"
Exp.Range("B" & rownumber + 8).Value = "Apr"
Exp.Range("B" & rownumber + 9).Value = "May"
Exp.Range("B" & rownumber + 10).Value = "Jun"
Exp.Range("B" & rownumber + 11).Value = "Jul"
Exp.Range("B" & rownumber + 12).Value = "Aug"
Exp.Range("B" & rownumber + 13).Value = "Sep"
Exp.Range("B" & rownumber + 14).Value = "Oct"
Exp.Range("B" & rownumber + 15).Value = "Nov"
Exp.Range("B" & rownumber + 16).Value = "Dec"

Exp.Range("B" & rownumber).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 1).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 2).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 3).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 4).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 5).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 6).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 7).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 8).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 9).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 10).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 11).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 12).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 13).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 14).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 15).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 16).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color

Exp.Range("C" & rownumber).Value = ActiveCell.Offset(0, 19).Value
Exp.Range("C" & rownumber + 1).Value = ActiveCell.Offset(0, 20).Value
Exp.Range("C" & rownumber + 2).Value = ActiveCell.Offset(0, 21).Value
Exp.Range("C" & rownumber + 3).Value = ActiveCell.Offset(0, 22).Value
Exp.Range("C" & rownumber + 4).Value = ActiveCell.Offset(0, 24).Value
Exp.Range("C" & rownumber + 5).Value = ActiveCell.Offset(0, 3).Value
Exp.Range("C" & rownumber + 6).Value = ActiveCell.Offset(0, 4).Value
Exp.Range("C" & rownumber + 7).Value = ActiveCell.Offset(0, 5).Value
Exp.Range("C" & rownumber + 8).Value = ActiveCell.Offset(0, 6).Value
Exp.Range("C" & rownumber + 9).Value = ActiveCell.Offset(0, 7).Value
Exp.Range("C" & rownumber + 10).Value = ActiveCell.Offset(0, 8).Value
Exp.Range("C" & rownumber + 11).Value = ActiveCell.Offset(0, 9).Value
Exp.Range("C" & rownumber + 12).Value = ActiveCell.Offset(0, 10).Value
Exp.Range("C" & rownumber + 13).Value = ActiveCell.Offset(0, 11).Value
Exp.Range("C" & rownumber + 14).Value = ActiveCell.Offset(0, 12).Value
Exp.Range("C" & rownumber + 15).Value = ActiveCell.Offset(0, 13).Value
Exp.Range("C" & rownumber + 16).Value = ActiveCell.Offset(0, 14).Value

Exp.Range("D" & rownumber).Value = ActiveCell.Offset(1, 19).Value
Exp.Range("D" & rownumber + 1).Value = ActiveCell.Offset(1, 20).Value
Exp.Range("D" & rownumber + 2).Value = ActiveCell.Offset(1, 21).Value
Exp.Range("D" & rownumber + 3).Value = ActiveCell.Offset(1, 22).Value
Exp.Range("D" & rownumber + 4).Value = ActiveCell.Offset(1, 24).Value
Exp.Range("D" & rownumber + 5).Value = ActiveCell.Offset(1, 3).Value
Exp.Range("D" & rownumber + 6).Value = ActiveCell.Offset(1, 4).Value
Exp.Range("D" & rownumber + 7).Value = ActiveCell.Offset(1, 5).Value
Exp.Range("D" & rownumber + 8).Value = ActiveCell.Offset(1, 6).Value
Exp.Range("D" & rownumber + 9).Value = ActiveCell.Offset(1, 7).Value
Exp.Range("D" & rownumber + 10).Value = ActiveCell.Offset(1, 8).Value
Exp.Range("D" & rownumber + 11).Value = ActiveCell.Offset(1, 9).Value
Exp.Range("D" & rownumber + 12).Value = ActiveCell.Offset(1, 10).Value
Exp.Range("D" & rownumber + 13).Value = ActiveCell.Offset(1, 11).Value
Exp.Range("D" & rownumber + 14).Value = ActiveCell.Offset(1, 12).Value
Exp.Range("D" & rownumber + 15).Value = ActiveCell.Offset(1, 13).Value
Exp.Range("D" & rownumber + 16).Value = ActiveCell.Offset(1, 14).Value

rownumber = rownumber + 17
ActiveCell.Offset(4, 0).Select

Loop

Answer 1

首先，excel非常擅长同时处理多行。

您所有的代码块基本上都将一个范围的格式和值转移到另一个范围。

这可以通过以下类型的逻辑来完成：

Exp.range("A1:D16").value = AnotherRange.value

因此，您可以采取一些措施来改善循环。几乎所有的块都可以以更简洁的形式重写。例如：

Exp.Range("B" & rownumber).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 1).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 2).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 3).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 4).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 5).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 6).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 7).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 8).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 9).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 10).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 11).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 12).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 13).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 14).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 15).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color
Exp.Range("B" & rownumber + 16).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color

可以重写为一个衬里：

Exp.Range(Exp.cells(rownumber,2),Exp.cells(rownumber+16,2)).Interior.Color = ActiveCell.Offset(0, 2).Interior.Color

您还可以将一个数组分配给一个范围：

dim headerArray as variant: headerArray = Array(Array("Q1", "Q2", "Q3", "Q4", "A", "Jan","Feb", "Mar","Apr","May","Jun","Jul", "Aug","Sep","Oct","Nov","Dec"))
Exp.Range(Exp.cells(rownumber,2),Exp.cells(rownumber+16,2)).value = Application.Transpose(headerArray)

Answer 2

您可以使用调整大小将重复的17行代码块减少到1例如

Range("A" & rowNumber).Resize(17, 1) = ActiveCell.Value

这不适用于右侧值发生变化的地方（例如带有“ Q1”的地方）

我强烈建议您使用父工作表名称来完全限定范围，并尽可能避免使用ActiveCell。使用步骤17或任何适当的步数，使用For Each循环循环显式范围。

有关删除.Select和其他语法/代码结构的帮助，请参见avoiding .Select。

如何重构长循环？

2 个答案: