Как разрешить выбор нескольких ячеек при отслеживании изменений для отдельных ячеек

Question

Я очень новичок в написании VBA-кодов и настроил код для отслеживания изменений в базовом файле Excel.Начиная с сокрытия и повторного открытия листа истории изменений трека при двойном щелчке по ячейке, затем workbook_SheetChange, указывающего, какую информацию я хочу отслеживать, и заканчивая Workbook_SheetSelectionChange.

Этот код работает отлично, если я выбираю только одну ячейку в мастер-файлепростынь.Как только я выбираю несколько ячеек, строк и столбцов или хочу скопировать и вставить, я получаю сообщение об ошибке во время выполнения «13» - Несоответствие типов.При отладке кода он выделяет эту часть кода:

    Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    oldValue = Target.Value
    oldAddress = Target.Address
    End Sub

В качестве глобальной переменной я написал: Dim oldValue as As String

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

Спасибо за помощь, и если вам нужна дополнительная информация, пожалуйста, дайте мне знать, Эми

Answer 1

Большое спасибо за ваш отзыв @PGCodeRider.Поскольку я действительно новичок в VBA, я не уверен, как интегрировать вышеперечисленное в код, который я написал.Я полностью понимаю ошибку, которую я вызываю.Цель отслеживания изменений: Первый лист - это наша основная база данных «Мастер-файл вариаций», команда А обновляет и поддерживает эту информацию.Каждое изменение должно отслеживаться на отдельном листе «Отслеженные изменения», чтобы наша команда B могла оценить и записать все изменения с обратной ссылкой.Это то, что я написал до сих пор, и я предполагаю, что это слишком просто, чтобы просто включить вышеупомянутое создание массива и цикл:

Dim oldValue As String
Dim oldAddress As String

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sSheetName As String
sSheetName = "Variation Masterfile"
If ActiveSheet.Name <> "Tracked Changes" Then
Application.EnableEvents = False
Sheets("Tracked Changes").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ActiveSheet.Name
Sheets("Tracked Changes").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = Target.Address(0, 0)
Sheets("Tracked Changes").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = oldValue
Sheets("Tracked Changes").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Target.Value
Sheets("Tracked Changes").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Environ("username")
Sheets("Tracked Changes").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = Date
Sheets("Tracked Changes").Range("A" & Rows.Count).End(xlUp).Offset(0, 6).Value = Time

Sheets("Tracked Changes").Columns("A:R").AutoFit
Application.EnableEvents = True
End If

If Target.Count > 1 Then Exit Sub
If ActiveSheet.Name <> "Tracked Changes" Then
Application.EnableEvents = False
Sheets("Tracked Changes").Hyperlinks.Add Anchor:=Sheets("Tracked Changes").Range("A" & Rows.Count).End(xlUp).Offset(0, 7), Address:="", SubAddress:="'" & sSheetName & "'!" & oldAddress, TextToDisplay:=oldAddress

Sheets("Tracked Changes").Columns("A:R").AutoFit
Application.EnableEvents = True
End If

If Target.Value <> "" Then
Target.Interior.ColorIndex = 7
End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
oldValue = Target.Value
oldAddress = Target.Address
End Sub

Answer 2

Вы пытаетесь отправить несколько значений строки ячейки в одну переменную (oldValue), что похоже на попытку скопировать несколько ячеек в одну ячейку.

Одним из решений может быть создание массива (ов), и цикл по каждой ячейке и обработка по отдельности.Вот пример одного из видоизмененных модификаций, чтобы соответствовать тому, что вы делаете:

    Dim trackChangesWS As Worksheet
    Set trackChangesWS = Sheet1 'wherever sheet these are being stored.

    Dim MaxArrayCount As Long
    MaxArrayCount = Target.Cells.Count - 1

   'Create Arrays (these could be combined for 1 with two dimensions, 
   'but keeping 2 to match your example)
    ReDim String_Array(0 To MaxArrayCount) As String
    ReDim Address_Array(0 To MaxArrayCount) As String

    Dim rCell As Range
    'loop through cells and capture address and cells
    For Each rCell In Target.Cells
        String_Array(i) = rCell.Value
        Address_Array(i) = rCell.Address
        i = i + 1
    Next rCell

    'set values on some corresponding sheet
    For i = 0 To MaxArrayCount
        trackChangesWS.Range(Address_Array(i)).Value = String_Array(i)
    Next i