Могу ли я сформировать массивы только для ячеек с вычисленными данными и не учитывать ячейки без данных и только базовые формулы? - PullRequest
0 голосов
/ 03 января 2019

Можно ли формировать массивы только с текстом внутри ячеек вместо циклического перебора пустых ячеек со встроенными формулами?

Например, у меня есть скрипт, который собирает UBound обоих измерений, но он также проходит по ячейкам без вычисляемых данных (кажется пустым).Это приводит к значительному увеличению времени выполнения, поскольку у меня есть встроенные формулы, охватывающие 1000 столбцов и 62 строки.

Как я мог сказать этому сценарию формировать массив только с ячейками, в которых был рассчитан текст, и игнорировать любые видимые пустые ячейки со встроенными формулами?

Option Explicit

Sub Main()
  Dim wb As Workbook
  Dim Data, Last, JobFamily
  Dim sourcerow As Long, destcol As Long, sourcecol As Long, destrow As Long
  Dim Dest As Range
  Dim BASEPATH As String

  Dim sPath, sFile As String

  BASEPATH = "M:\Combine\"

  sPath = "M:\VBA\"
  sFile = sPath & "Book2.xlsx"

  Set wb = Workbooks.Open(sFile)
  Set Dest = wb.Sheets("Sheet1").Range("B1")
  With ThisWorkbook.Sheets("Profiles")
    Data = .Range("B1", .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, .Columns.Count).End(xlToLeft))
  End With
  wb.Activate
  Application.ScreenUpdating = False

  For sourcecol = 1 To UBound(Data, 2)
    If Data(1, sourcecol) <> Last Then
      If sourcecol > 1 Then
        Dest.Select
          wb.SaveCopyAs BASEPATH & _
          ValidFileName(Last & ".xlsx")
      End If

      Dest.Resize(, Columns.Count - Dest.Column).EntireColumn.ClearContents
      Last = Data(1, sourcecol)
      destcol = 0
    End If

    destrow = 0
    For sourcerow = 1 To UBound(Data)
      Dest.Offset(destrow, destcol) = Data(sourcerow, sourcecol)
      destrow = destrow + 1
    Next

    destcol = destcol + 1
  Next
End Sub

1 Ответ

0 голосов
/ 03 января 2019

Да, вы можете использовать метод SpecialCells объекта Range.Вот небольшая автономная демонстрация.Более подробная информация здесь SpecialCells

Private Sub BuildConstantRange()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        .Cells(1, 1).Value = "1"
        .Cells(2, 1).Value = "2"
        .Cells(3, 1).Value = "=if(1=1,1,0)"
        .Cells(4, 1).Value = "=if(1=1,1,0)"
        .Cells(5, 1).Value = "3"

        Dim rng As Range: Set rng = .Range("A1:A5").SpecialCells(xlCellTypeConstants)
        Dim cell As Range

        For Each cell In rng
            Debug.Print cell.Address
        Next
    End With

End Sub

Вывод:

$A$1
$A$2
$A$5

Какие ячейки не имеют формулы.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...