Запись всего ряда ячеек (со ссылками на другие ячейки) автоматически при изменении ячеек, на которые есть ссылки - PullRequest
1 голос
/ 01 июня 2019

У меня есть формулы, которые мне нужно изменить, которые имеют выходы и решения. Я создал целую строку A46:CV42, которая показывает каждое значение (решение для формул) в каждой ячейке. Что мне нужно, так это записывать каждое отдельное изменение во всю строку автоматически каждый раз, когда изменяется любое значение ячейки. Будь то на том же листе под ним в повторяющихся строках или на другом листе.

Я пробовал кое-что, что нашел, но все они касаются изменения отдельных ячеек или изменения данных вручную.

Пример того, что я пробовал. Я новичок в этой области.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$2" Then
        a = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row + 1
        Sheets("Sheet2").Range("A" & a).Value = Sheets("Sheet1").Range("A").Value
    End If
End Sub

1 Ответ

0 голосов
/ 01 июня 2019

Я не совсем уверен, хотите ли вы строку 46 или строку 42.Ниже приведен подход и комментарии в коде для получения более подробной информации:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wb As Workbook: Set wb = ThisWorkbook

    Dim wsWatch As Worksheet: Set wsWatch = wb.Sheets("Sheet1") 'declare and set the sheet (change the name or use Target.Worksheet instead as needed)
    Dim rngWatch As Range: Set rngWatch = wsWatch.Range("A46:CV46") 'declare and set the range to watch over
    Dim arrWatch As Variant: arrWatch = rngWatch 'allocate the range to an array

    Dim wsHistory As Worksheet: Set wsHistory = wb.Sheets("Sheet2") 'declare and set the sheet
    With wsHistory
        Dim lRow As Long: lRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'get the last row in the history
        Dim rngHistory As Range: Set rngHistory = .Range(.Cells(lRow, 1), .Cells(lRow, 100)) 'declare and set the range of the last populated row (last historic change)
    End With
    Dim arrHistory As Variant: arrHistory = rngHistory 'allocate the range to an array

    Dim C As Long

    'Only one row in the arrays, let's loop over the columns
    For C = LBound(arrWatch, 2) To UBound(arrWatch, 2) 'for each column in the ranges
        If arrWatch(1, C) <> arrHistory(1, C) Then 'if there is a mismatch
            rngHistory.Offset(1) = rngWatch.Value 'allocate the values in the next free row
            Exit For 'exit here if mismatch found
        End If
    Next C
End Sub

Возможно, это не идеальное решение, но я с нетерпением жду возможности увидеть другие решения ... между тем, я думаю, что этоделает то, что вы просили.

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