Замена формул на нескольких листах разными значениями на основе другого листа VBA - PullRequest
0 голосов
/ 01 апреля 2020

Мой текущий код создает 9 копий листа с именем «MasterCalculator». Он определяет количество имен, которые должны быть названы, путем подсчета количества ячеек, заполненных в строке 1 (начиная со столбца C) на другом листе под названием «LLP Dis c Sheet». Каждый из 9 созданных листов затем назван. Название листа 1 происходит от C1 в «LLP Dis c Sheet», имя листа 2 происходит от D1 в «LLP Dis c Sheet», названия листа 3 происходят от E1 в «LLP Dis c Sheet» , и так далее.

Option Explicit

Public Sub NewSheets()
Dim shCol   As Integer
Dim i       As Integer
Dim ws      As Worksheet
Dim sh      As Worksheet
Set ws = Sheets("MasterCalculator")
Set sh = Sheets("LLP Disc Sheet")
Application.ScreenUpdating = 0
Application.EnableEvents = 0
shCol = 2
sh.Activate
For i = 2 To sh.Range("A1:Z1").Cells.SpecialCells(xlCellTypeConstants).Count
    shCol = shCol + 1
    Application.StatusBar = "Processing " & sh.Cells(1, shCol).Text & Format(i /     sh.Range("A1:Z1").Cells.SpecialCells(xlCellTypeConstants).Count, "  #0.0 %")
    Select Case shCol
    Case Is = 3
        ws.Copy After:=sh
    Case Else
        ws.Copy After:=Sheets(sh.Cells(1, shCol - 1).Text)
    End Select
    ActiveSheet.Name = sh.Cells(1, shCol).Text  
    Application.CutCopyMode = False
Next i
sh.Activate
Application.StatusBar = 0
Application.EnableEvents = 1
Application.ScreenUpdating = 1
Application.CalculateFull
End Sub

Итак, теперь, когда все листы созданы и названы ... Теперь я хочу обновить формулы в каждом из них, поскольку они являются копиями листа с именем «MasterCalculator». На каждом листе есть 2 ячейки, которые мне нужно обновить - ячейка B1 и ячейка M4. Ячейка B1 содержит формулу "= + 'LLP Dis c Sheet'! C1". Лист, созданный на основе C1 в «LLP Dis c Sheet», может сохранить эту формулу. Однако следующий лист (лист 2), который был создан и назван на основе D1 в «LLP Dis c Sheet», необходимо обновить до «= + 'LLP Dis c Sheet'! D1». Это продолжается с остальными листами. Следующий должен измениться на = + 'LLP Dis c Sheet'! E1 и так далее. Как создать код для замены этой ячейки в каждом из вновь созданных листов обновленной формулой, которая изменяет его только на ячейку, на которую ссылается одна ячейка после в «LLP Dis c Sheet»?

ActiveSheet.Range(“B1:M4”).Replace_
What: ="LLP Disc Sheet'!C1", Replacement:="LLP Disc Sheet'!D1”,_    ‘but I want it to continue to the next sheet to replace D1 with E1 and so on until all of the B1 cells match their sheet names (it also allow all the data to be filled in). All of these will be found in cell B1 in the MasterCalculator copies 
What: ="LLP Disc Sheet'!$C$1:$C$", Replacement:=" LLP Disc Sheet'!$D$1:$D$”,_   ‘but I want it to continue to the next sheet to replace $D$1 with E$1$ and $D$ with $E$ and so on until all of the M4 cells are set to 0. 
SearchOrder:=xlByRows, MatchCase:=True

1 Ответ

0 голосов
/ 02 апреля 2020

Использование формулаR1C1

Option Explicit

Public Sub NewSheets()

    Dim wb As Workbook, ws As Worksheet, wsMaster As Worksheet
    Dim iLastCol As Integer, iCol As Integer
    Dim s As String, n As Integer

    Set wb = ThisWorkbook
    Set wsMaster = wb.Sheets("MasterCalculator")
    Set ws = wb.Sheets("LLP Disc Sheet")
    iLastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column

    n = wb.Sheets.Count
    For iCol = 3 To iLastCol
        s = ws.Cells(1, iCol) ' sheet name
        If Len(s) > 0 Then
            wsMaster.Copy After:=Sheets(n)
            n = n + 1
            wb.Sheets(n).Name = s
            wb.Sheets(n).Range("B1,M4").FormulaR1C1 = "='" & ws.Name & "'!R1C" & iCol
        End If
    Next

    MsgBox iLastCol - 2 & " sheets added", vbInformation

End Sub

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