以前也经常遇到类似问题，并且其解决技巧很有效率，因此在这里和大家分享。

如下所示的工作表，在主工作表MASTER中存放着从数据库下载的全部数据。现在，要根据列E中的数据将前12列的数据分别复制到其他工作表中，其中，列E中数据开头两位数字是61的单元格所在行前12列数据复制到工作表61中，开头数字是62的单元格所在行前12列数据复制到工作表62中，同样，开头数字是63的复制到工作表63中，开头数字是64或65的复制到工作表64_65中，开头数字是68的复制到工作表68中。

用来完成上述工作的VBA代码如下：

Sub MasterDataToSheets()

Dim x

Dim i As Long

Dim ii As Long

Dim i61 As Integer

Dim i62 As Integer

Dim i63 As Integer

Dim i6465 As Integer

Dim i68 As Integer

‘选择前12列数据并赋给数组

x = Sheet1.Cells(1).CurrentRegion.Resize(,12)

‘重新定义数组大小

ReDim Data61(1 To UBound(x, 1), 1 To 12)

ReDim Data62(1 To UBound(x, 1), 1 To 12)

ReDim Data63(1 To UBound(x, 1), 1 To 12)

ReDim Data6465(1 To UBound(x, 1), 1 To 12)

ReDim Data68(1 To UBound(x, 1), 1 To 12)

‘遍历数据并将第5列符合条件的数据存储到相应的数组中

For i = 2 To UBound(x, 1)

Select Case Left(x(i, 5), 2)

Case 61

i61 = i61 + 1

For ii = 1 To 12

Data61(i61, ii) = x(i, ii)

Next

Case 62

i62 = i62 + 1

For ii = 1 To 12

Data62(i62, ii) = x(i, ii)

Next

Case 63

i63 = i63 + 1

For ii = 1 To 12

Data63(i63, ii) = x(i, ii)

Next

Case 64, 65

i6465 = i6465 + 1

For ii = 1 To 12

Data6465(i6465, ii) = x(i,ii)

Next

Case 68

i68 = i68 + 1

For ii = 1 To 12

Data68(i68, ii) = x(i, ii)

Next

End Select

Next

‘关闭屏幕更新

Application.ScreenUpdating = False

‘更新工作表61中的数据

WithSheets(“61”).Cells(1).CurrentRegion

‘清除原有内容，标题行除外

.Offset(1).Resize(.Rows.Count,12).ClearContents

‘从单元格A2开始输入数据

.Parent.[A2].Resize(UBound(Data61, 1),12) = Data61

End With

‘更新工作表62中的数据

WithSheets(“62”).Cells(1).CurrentRegion

.Offset(1).Resize(.Rows.Count, 12).ClearContents

.Parent.[A2].Resize(UBound(Data62, 1),12) = Data62

End With

‘更新工作表63中的数据

WithSheets(“63”).Cells(1).CurrentRegion

.Offset(1).Resize(.Rows.Count,12).ClearContents

.Parent.[A2].Resize(UBound(Data63, 1), 12)= Data63

End With

‘更新工作表64、65中的数据

WithSheets(“64_65”).Cells(1).CurrentRegion

.Offset(1).Resize(.Rows.Count,12).ClearContents

.Parent.[A2].Resize(UBound(Data6465,1), 12) = Data6465

End With

‘更新工作表68中的数据

WithSheets(“68”).Cells(1).CurrentRegion

.Offset(1).Resize(.Rows.Count,12).ClearContents

.Parent.[A2].Resize(UBound(Data68, 1),12) = Data68

End With

‘开启屏幕更新

Application.ScreenUpdating = True

‘提示用户更新数据已完成

MsgBox “所有工作表都已更新!”, 64, “已完成”

End Sub

运行代码后，工作表61中的数据如下所示。

代码并不难，很实用！在代码中，我已经给出了一些注释，有助于对代码的理解。个人觉得，这段代码的优点在于：

将数据存储在数组中，并从数组中取出相应的数据。

将数组数据直接输入到工作表单元格，提高了代码的简洁性和效率。

将代码适当修改，可以方便地实现类似的需求。

阅读全文