Скопируйте диапазон формул на листах - PullRequest
0 голосов
/ 28 ноября 2018

У меня есть ряд формул, которые необходимо скопировать на все рабочие листы.Диапазон идет от AB1: AC5.Формулы должны работать на всех листах и ​​взяты из листа под названием «Шаблон», который является первым листом в книге.Я считаю, что я уже выбрал диапазон, и он будет продолжать копировать только из «Шаблон».Как бы я мог вставить его на каждый другой лист?

Sub FillSheets()
 Dim sh As Worksheet
 Dim rng As Range

 Dim worksheetsToSkip As Variant

 worksheetsToSkip = Array("Aggregated", "Collated Results", "Template", "End")
 Set rng = Sheet1.Range("AB1:AC5")

 For Each ws In Worksheets
    If IsError(Application.Match(ws.Name, worksheetsToSkip, 0)) Then


End Sub

Ответы [ 2 ]

0 голосов
/ 28 ноября 2018

Восклицательный знак, выпуск

Ячейки, содержащие ссылки на листы

Существует лист с именем Template.Вы можете написать в ячейку A1 формулу =A2+A3.Вы также можете написать =Template!A2+A3 или =Template!A2+Template!A3.Во всех трех случаях результат одинаков.Но когда вы Paste Special формул в другой лист, вы получите разные формулы в каждом случае и, следовательно, возможно, разные результаты.Этот код устраняет эту возможность, вставляя только первый сценарий (=A2+A3).

Когда Excel записывает эти листовые ссылки на лист?

В нашем примере случай =Template!A2+A3 мог произойти при выборе вкладки Template, в строке формул знак равенства(=), была нажата другая вкладка, затем была нажата вкладка Template, введено A2+A3 и нажата ENTER.
Случай =Template!A2+Template!A3 мог произойти, когда Template была выбрана вкладка, в строке формул был введен знак равенства (=), нажата другая вкладка, затем нажата вкладка Template, выбрана A2, снова нажата другая вкладка, (+), снова была нажата вкладка Template, выбрано A3 и нажата ENTER.

Option Explicit

'*******************************************************************************
' Purpose:  Pastes formulas from a range in an initial worksheet               *
'           to the same range in all worksheets that are not included          *
'           in a specified worksheet-names list of exceptions.                 *
' Remarks:  There has to be a worksheet with the codename "Sheet1"             *
'           in the workbook in which this code resides or it will not compile. *
'*******************************************************************************
Sub FillSheetsWithRangeOfFormulas()

  Const cStrRange = "AB1:AC5"                         ' Initial Range Address
  Const cStrSkip = "Aggregated,Collated Results,End"  ' List of Exceptions
  Const cStrSkipSeparator = ","                       ' List of Exceptions Sep.

  Dim objWs As Worksheet      ' Worksheet Object to be Used in a For Each Loop
  Dim vntSkip As Variant      ' List of Exceptions Array
  Dim vntFormulas As Variant  ' Formulas Array
  Dim lngRows As Long         ' Formulas Array Rows Counter
  Dim intColumns As Integer   ' Formulas Array Columns Counter
  Dim vntWb As Variant        ' Workbooks Array
  Dim intWb As Integer        ' Workbooks Array Rows Counter
  Dim strDel As String        ' Worksheet Reference String ("!" & Sheet1.Name)
  Dim strWb As String         ' Workbooks Array Split String ("]" & strDel)
  Dim strWbTemp As String     ' Workbooks Array Temporary String ("" or strWb)
  Dim strWbResult As String   ' Workbooks Array Resulting String

  With Sheet1
    ' Paste Initial-Range formulas into (1-based 2-dimensional) Formulas Array.
    vntFormulas = .Range(cStrRange).Formula
    ' Define Worksheet Decalaration String
    strDel = .Name & "!"
  End With

  ' Define Workbooks Array Split String to use to not remove worksheet
  ' references to sheets with the same name as Sheet1 in other workbooks.
  strWb = "]" & strDel

  ' Remove worksheet(!) references from formulas in Formulas Array.

  ' In the following For-Next loop, in the comments, "Template" for Sheet1's
  ' name is used.

  For intColumns = LBound(vntFormulas, 2) To UBound(vntFormulas, 2)
    For lngRows = LBound(vntFormulas) To UBound(vntFormulas)

      ' Check if element does not contain "]Template!" which would indicate that
      ' it is linking to a sheet with the same name in another workbook.
      If InStr(1, vntFormulas(lngRows, intColumns), strWb, _
          vbTextCompare) = 0 Then   ' Does NOT contain "]Template!" (strWb).

        ' Check if element contains just "Template!" (strDel).
        If InStr(1, vntFormulas(lngRows, intColumns), strDel, _
            vbTextCompare) <> 0 Then    ' DOES contain "Template!" (strDel).
          ' Write resulting string to Formulas Array (overwriting).
          vntFormulas(lngRows, intColumns) = Replace(vntFormulas(lngRows, _
              intColumns), strDel, "", , , vbTextCompare)
'         Else                          ' Does NOT contain "Template!" (strDel).
        End If

       Else                         ' DOES contain "]Template!" (strWb).

        strWbResult = ""
        ' Split the element's string by "]Template!" (strWb) into a 0-based
        ' 1-dimensional array.
        vntWb = Split(vntFormulas(lngRows, intColumns), strWb, , vbTextCompare)
        ' Rebuild the string removing additional "Template!" (strDel) strings.
        For intWb = LBound(vntWb) To UBound(vntWb)
          If intWb <> 0 Then ' Is NOT first element of array.
            strWbTemp = strWb
           Else              ' IS first element of array.
            strWbTemp = ""
          End If
          ' Check if element contains just "Template!" (strDel).
          If InStr(1, vntWb(intWb), strDel, _
              vbTextCompare) <> 0 Then  ' DOES contain "Template!" (strDel).
            strWbResult = strWbResult & strWbTemp & Replace(vntWb(intWb), _
                strDel, "", , , vbTextCompare)
           Else                         ' Does NOT contain "Template!" (strDel).
            strWbResult = strWbResult & strWbTemp & vntWb(intWb)
          End If
        Next
        Erase vntWb
        ' Write resulting string to Formulas Array (overwriting).
        vntFormulas(lngRows, intColumns) = strWbResult

      End If

    Next
  Next

  With Sheet1
    ' Populate (0-based 1 dimensional) List of Exceptions Array (vntSkip),
    ' after adding Sheet1's name (.Name i.e. Sheet1.Name).
    vntSkip = Split(cStrSkip & cStrSkipSeparator & .Name, cStrSkipSeparator)
    ' Paste Formulas Array (vntFormulas) into the range (same size and position
    ' as the Initial Range (cStrRange)) of each worksheet whose name is not
    ' contained in the List of Exceptions (vntSkip) in the workbook
    ' (.Parent.Name i.e. Sheet1.Parent.Name) where Sheet1 resides.
    For Each objWs In Workbooks(.Parent.Name).Worksheets
      If IsError(Application.Match(objWs.Name, vntSkip, 0)) Then _
          objWs.Range(cStrRange).Formula = vntFormulas
    Next
  End With

  Erase vntSkip
  Erase vntFormulas

End Sub
'*******************************************************************************
0 голосов
/ 28 ноября 2018

вы были довольно близко, так как вам пришлось использовать свойство Formula объекта Range и ссылку на диапазон "источника" Address

, у вас было несоответствие имени переменной: объявленоsh As Worksheet но тогда вы использовали ws

попробуйте это:

Sub FillSheets()
    Dim sh As Worksheet
    Dim rng As Range

    Dim worksheetsToSkip As Variant

    worksheetsToSkip = Array("Aggregated", "Collated Results", "Template", "End")
    Set rng = Sheet1.Range("AB1:AC5")

    For Each sh In Worksheets
       If IsError(Application.Match(sh.Name, worksheetsToSkip, 0)) Then sh.Range(rng.Address).Formula = rng.Formula
    Next
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...