Question

我设计了以下代码。我想了解ws.cells(Y,2)中是否可以使用命名范围？我试图命名代码ws.Range("Name")，但它失败了。目的是搜索寻找特定标准的数据列（粗体和＆lt; 1）。找到后，它会将数据结果填充到另一个工作表中。搜索应该从上到下，直到找到符合条件的前7个匹配项。我正在寻求协助编写代码，以便更快，2）更快。

  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

以下代码并未针对*命名范围解决“子问题”，因为我不理解该部分。

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

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位）来测试这个假设。显然，主要的性能差异为~14％（比较使用Offset的10次迭代的平均值和避免它的另外10次迭代）。

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

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（例如）和（2）直接使用数组来代替复制值，仍然可以大大提高速度。

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

Answer 2

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

如果名称范围指的是活动工作表，则ws.range("name")将起作用。但如果它引用了非活动工作表，ws.range("name")将引发错误。

由于名称范围是工作簿级别范围，因此您只需执行Range("name")即可。那么你就不会得到上面的错误。

P / S：写Range("Name")的另一种方式是[Name]，它看起来更干净但却缺少智能感知。

Excel 2010 vba代码 - 更清晰的代码

2 个答案:

更新