Excel 2010 vba code – более чистый код

У меня есть следующий код. Я хотел бы понять, может ли именованный диапазон использоваться в ws.cells(Y,2) ? Я попытался назвать код ws.Range("Name") но он не удался. Цель состоит в поиске столбца данных, определяющих конкретные критерии (жирным шрифтом и <1). После этого он заполняет результаты данных на другом листе. Поиск должен быть сверху донизу, пока он не найдет первые 7 совпадений с критериями. Я ищу помощь в написании кода, так что это 1) чище и 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 

Диапазон имен – это диапазон уровня рабочей книги, а не диапазон уровня рабочей области.

Если диапазон имен относится к активному листу, тогда будет работать ws.range("name") . Но если это относится к неактивному листу, ws.range("name") ошибку.

Поскольку диапазон имен – это диапазон уровня рабочей книги, вы можете просто использовать Range("name") . Тогда вы не получите ошибку выше.

P / S: другой способ записи Range("Name")[Name] который выглядит более чистым, но отсутствует intellisense.

Следующий код не относится к «второму вопросу» относительно * названных диапазонов, поскольку я не понял эту часть.

Тем не менее, следующий код немного короче и, возможно, даже легче читать. Кроме того, некоторые незначительные улучшения были сделаны в отношении скорости:

 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% (сравнивая среднее из 10 итераций с использованием Offset и еще 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 .

  • COUNTIF с несколькими критериями для возврата разных результатов
  • HTML-таблица Экспорт в Excel utf-8 символов
  • Преобразование заголовков в одной колонке
  • Индивидуальная группа данных дня в неделю и countif = A
  • Справочная внешняя книга с несколькими листами
  • Изменение цветов диаграммы при копировании рабочей таблицы в новую книгу
  • Как использовать «триггер» в Excel 2010 для преобразования значения в введенное имя строки и имя столбца?
  • Как я использую возвращаемое значение как ячейку no
  • Как я могу распределить общий процент по процентам, где каждая ячейка является целым числом, и они суммируются точно с исходной суммой?
  • Условные форматирование ячеек, если их значение равно ЛЮБОМ значению другого столбца
  • Excel VBA - Как выбрать несколько целых столбцов из определенных диапазонов?
  • Interesting Posts

    COUNTIF () в цикле «For»

    MATCH и переставить в excel

    Ячейка Excel COUNTIF содержит заданный текст (частичное совпадение)

    Выполнение кода во всех ячейках, во всех листах, во всей рабочей книге

    Excel VBA – копирование данных из основного листа в различный выбор на основе листов

    Excel vba применяет фильтр «фильтр по цвету» и «текстовый фильтр» вместе в одном столбце

    вставить значение из текстового поля в определенную ячейку в excel в C # .NET

    Обновить все на PowerQuery из веб-запроса, не вытягивая обновленные данные – Excel

    Динамический VLOOKUP с КОСВЕННЫМ

    Как перебирать листы Excel, выполнять вычисления и компилировать результаты

    VBA: как сравнить ячейку с диапазоном и цветом между

    Не удалось расширить формулу VLOOKUP

    VBA WinHTTP для загрузки файла с защищенного паролем https-сайта

    Excel. Делайте формат в строке, если дата выше не совпадает.

    Excel: как найти строки на разных листах с одинаковыми данными -> изменить данные

    Давайте будем гением компьютера.