Excel 2010 vba代码 – 一个更干净的代码

我有devise下面的代码。 我想知道是否可以在ws.cells(Y,2)使用命名的范围？ 我试图命名代码ws.Range("Name")但失败了。 目的是search一列数据寻找特定的标准（粗体和<1）。 一旦find，它将数据结果填充到另一个工作表。 search应该是从上到下，直到find与标准的前7个匹配。 我正在寻求编写代码的帮助，以便更清洁，更快速。

  X = 12 Y = 4 Z = 0 Set ws = Worksheets("Schedule") Do Until Z = 7 If ws.Cells(Y, 2).font.Bold = True And ws.Cells(Y, 2) < 1 Then ws.Activate ws.Cells(Y, 2).Offset(rowOffset:=0, columnOffset:=1).Activate ActiveCell.Copy Destination:=Worksheets("Project Status").Cells(X, 3) ws.Cells(Y, 2).Offset(rowOffset:=0, columnOffset:=3).Activate ActiveCell.Copy Destination:=Worksheets("Project Status").Cells(X, 6) ws.Cells(Y, 2).Offset(rowOffset:=0, columnOffset:=4).Activate ActiveCell.Copy Destination:=Worksheets("Project Status").Cells(X, 7) ws.Cells(Y, 2).Offset(rowOffset:=0, columnOffset:=0).Activate ActiveCell.Copy Destination:=Worksheets("Project Status").Cells(X, 8) X = X + 1 Y = Y + 1 Z = Z + 1 Else Y = Y + 1 End If Loop 

Answer 1

名称范围是工作簿级别范围，而不是工作表级别范围。

如果名称范围指向活动工作表，则ws.range("name")将起作用。 但是，如果它指向一个非活动表单， ws.range("name")将会抛出一个错误。

因为名称范围是一个工作簿级别的范围，所以你可以简单地做Range("name") 。 那么你不会得到上面的错误。

P / S：另一种编写Range("Name")是[Name] ，看起来更干净但缺lessintellisense。

Answer 2

下面的代码没有解决关于*命名范围的“子问题”，因为我不明白这个部分。

然而，下面的代码有点短，甚至更容易阅读。 另外，在速度方面做了一些小的改进：

 Option Explicit Public Sub tmpSO() Dim WS As Worksheet Dim X As Long, Y As Long, Z As Long X = 12 Z = 0 Set WS = ThisWorkbook.Worksheets("Schedule") With Worksheets("Project Status") For Y = 4 To WS.Cells(WS.Rows.Count, 2).End(xlUp).Row If WS.Cells(Y, 2).Font.Bold And WS.Cells(Y, 2).Value2 < 1 Then WS.Cells(Y, 2).Offset(0, 1).Copy Destination:=.Cells(X, 3) WS.Cells(Y, 2).Offset(0, 3).Copy Destination:=.Cells(X, 6) WS.Cells(Y, 2).Offset(0, 4).Copy Destination:=.Cells(X, 7) WS.Cells(Y, 2).Offset(0, 0).Copy Destination:=.Cells(X, 8) X = X + 1 Z = Z + 1 ' Else ' Y = Y + 1 End If If Z = 7 Then Exit For Next Y End With End Sub 

也许你可以详细阐述一下为什么你要使用命名的范围，以及你希望用他们达到的目标，你不能用上面的代码实现。

更新：

Miqi180让我意识到，通过直接引用单元格来避免Offset ，可能会有性能差异。 所以，我在我的系统（Office 2016,64位）上进行了一个小型的性能testing来testing这个假设。 显然，有一个主要的性能差异〜14％（比较使用Offset的10次迭代的平均值和避免10次迭代的平均值）。

这是我用来testing速度差异的代码。 如果您认为此设置存在缺陷，请告诉我们：

 Option Explicit ' Test whether you are using the 64-bit version of Office. #If Win64 Then Declare PtrSafe Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long #Else Declare Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long #End If Public Sub SpeedTestDirect() Dim i As Long Dim ws As Worksheet Dim dttStart As Date Dim startTime As Currency, endTime As Currency Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False Set ws = ThisWorkbook.Worksheets(1) ws.Cells.Delete dttStart = Now getTickCount startTime For i = 1 To 1000000 ws.Cells(i, 1).Value2 = 1 ws.Cells(i, 2).Value2 = 1 ws.Cells(i, 3).Value2 = 1 ws.Cells(i, 4).Value2 = 1 ws.Cells(i, 5).Value2 = 1 ws.Cells(i, 6).Value2 = 1 Next i Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True getTickCount endTime Debug.Print "Runtime: " & endTime - startTime, Format(Now - dttStart, "hh:mm:ss") End Sub Public Sub SpeedTestUsingOffset() Dim i As Long Dim ws As Worksheet Dim dttStart As Date Dim startTime As Currency, endTime As Currency Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False Set ws = ThisWorkbook.Worksheets(1) ws.Cells.Delete dttStart = Now getTickCount startTime For i = 1 To 1000000 ws.Cells(i, 1).Offset(0, 0).Value2 = 1 ws.Cells(i, 1).Offset(0, 1).Value2 = 1 ws.Cells(i, 1).Offset(0, 2).Value2 = 1 ws.Cells(i, 1).Offset(0, 3).Value2 = 1 ws.Cells(i, 1).Offset(0, 4).Value2 = 1 ws.Cells(i, 1).Offset(0, 5).Value2 = 1 Next i Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True getTickCount endTime Debug.Print "Runtime: " & endTime - startTime, Format(Now - dttStart, "hh:mm:ss") End Sub 

基于这个发现，改进的代码应该是（感谢Miqi180）：

 Public Sub tmpSO() Dim WS As Worksheet Dim X As Long, Y As Long, Z As Long X = 12 Z = 0 Set WS = ThisWorkbook.Worksheets("Schedule") With Worksheets("Project Status") For Y = 4 To WS.Cells(WS.Rows.Count, 2).End(xlUp).Row If WS.Cells(Y, 2).Font.Bold And WS.Cells(Y, 2).Value2 < 1 Then WS.Cells(Y, 3).Copy Destination:=.Cells(X, 3) WS.Cells(Y, 5).Copy Destination:=.Cells(X, 6) WS.Cells(Y, 6).Copy Destination:=.Cells(X, 7) WS.Cells(Y, 2).Copy Destination:=.Cells(X, 8) X = X + 1 Z = Z + 1 ' Else ' Y = Y + 1 End If If Z = 7 Then Exit For Next Y End With End Sub 

然而，应该指出的是，速度仍然可以通过移动到（1）仅拷贝/直接使用.Cells(X, 3).Value2 = WS.Cells(Y, 2).Value2 （for例如）和（2）另外使用数组来代替。

_{当然，这还不包括Application.ScreenUpdating = False ， Application.Calculation = xlCalculationManual和Application.EnableEvents = False等标准build议。}