Çok boyutlu diziden adresleri yapıştırdıktan sonra tıklanabilir hücre başvuruları nasıl yapılır

Question

Makromum çalışırken yaptığım tüm değişiklikleri depolamak için kullanacağım aşağıdaki alt rutinim var.

Public ChangeLog() As String 

Sub Test() 
Erase ChangeLog 
' Dim WS As Worksheet: Set WS = Sheets.Add(After:=Worksheets(Worksheets.Count)) 
' WS.Name = "Change Log" 
' WS.Tab.Color = vbYellow 
    Log ActiveSheet.Range("A2"), "Test1" 
    Log ActiveSheet.Range("B2"), "Test2" 
    Log ActiveSheet.Range("C2"), "Test3" 
    'ActiveSheet.Range("B3") = ChangeLog 
    ActiveSheet.Range("A1").Resize(UBound(ChangeLog, 2) + 1, 2) = WorksheetFunction.Transpose(ChangeLog) 
End Sub 

Function Log(Cell As Range, Reason As String) As String 
    On Error Resume Next 
    If (Not Not ChangeLog) = 0 Then 
     ReDim ChangeLog(0 To 1, 0 To 1) 
     ChangeLog(0, 0) = "Cells": ChangeLog(1, 0) = "Changes Made" 
     ChangeLog(0, 1) = Cell.Address: ChangeLog(1, 1) = Reason 
    Else 
     ReDim Preserve ChangeLog(0 To 1, 0 To UBound(ChangeLog, 2) + 1) 
     ChangeLog(0, UBound(ChangeLog, 2)) = Cell.Address: ChangeLog(1, UBound(ChangeLog, 2)) = Reason 
    End If 
    On Error GoTo 0 
End Function 

Sonuç:

ben ben çalışma yapıştırmak diziye ChangeLog, hatanın için hücre adresini ve nedenini yazma kullanıcıya dikkat gerekir, düzenleme yapmak her zaman Makamın sonundaki Etkin sayfanın yanında. Test amaçlı olarak, yeni elektronik tabloyu eklediğim bölümü hariç tuttum, böylece çok boyutlu diziyi doğru bir şekilde ele aldığımdan emin olabilirim (bu benim bir zayıflığım). Bu iyi çalışır, ancak hücre adreslerini köprüler/tıklanabilir yapmak istiyorum, böylece kullanıcıyı bu hatanın olduğu/hesaplandığı ilk elektronik tablodaki noktaya getirecekler (makronun temizlenip temizlenmediğine veya belirli bir noktaya işaret edip etmediğine bağlı olarak) hata).

Yani, sorularım şunlardır: diziden yeni elektronik tabloya üzerine yapıştırarak zaman

1. nasıl tıklanabilir hücre başvuruları hepsi yapılabilir? En hızlı yöntem ne olurdu?
2. Bu verimli bir yöntem midir yoksa daha kolay bir yol var mı (her seferinde işlevi çağırmak yerine)?

Answer 1

Bunu, Hyperlink formülüyle çalışarak ve değerleri diziye okuyorken formülleri oluşturarak başarabiliyorum. Bu şekilde, dizinin tamamını bir aralığa yapıştırdığınızda, formüller/bağlantılar zaten aktiftir ve tıklanabilir, yani her bir değere döngü geçirme ve bağlantıyı kurma adımını atlayabilirsiniz. Önceden hazırlanmış köprüler içinde

Public ChangeLog() As String 

Sub Test() 
    Erase ChangeLog 
    Log ActiveSheet.Range("A2"), "Test1" 
    Log ActiveSheet.Range("B2"), "Test2" 
    Log ActiveSheet.Range("C2"), "Test3" 
    Dim WS As Worksheet: Set WS = Sheets.Add(After:=Worksheets(1)) 
    WS.Name = "Change Log" 
    WS.Tab.Color = vbYellow 
    WS.Range("A1").Resize(UBound(ChangeLog, 2) + 1, 2) = WorksheetFunction.Transpose(ChangeLog) 
End Sub 

Function Log(Cell As Range, Reason As String) As String 
    On Error Resume Next 
    If (Not Not ChangeLog) = 0 Then 
     ReDim ChangeLog(0 To 1, 0 To 1) 
     ChangeLog(0, 0) = "Cells": ChangeLog(1, 0) = "Changes Made" 
     ChangeLog(0, 1) = "=Hyperlink(" & """#'" & ActiveSheet.Name & "'!" & Cell.Address(False, False) & """,""" & Cell.Address(False, False) & """)" 
     ChangeLog(1, 1) = "Hyperlink Test" 
    Else 
     ReDim Preserve ChangeLog(0 To 1, 0 To UBound(ChangeLog, 2) + 1) 
     ChangeLog(0, UBound(ChangeLog, 2)) = "=Hyperlink(" & """#'" & ActiveSheet.Name & "'!" & Cell.Address(False, False) & """,""" & Cell.Address(False, False) & """)" 
     ChangeLog(1, UBound(ChangeLog, 2)) = Reason 
    End If 
    On Error GoTo 0 
End Function 

Sonuçlar:

Answer 2

misiniz Application.Goto yöntem takım hiç köprüler için gerek kalmadan görev? Bir Selection_Change olayını yakalayabilirsiniz (bir hücre tıklandığında gerçekleşir). Hücrenin, değişiklik hücrenizin adresini içerdiği göz önüne alındığında, yalnızca bu adreste Goto olabilir.

Aşağıdaki örnek kod size bir iskelet fikir verir, ama örneğin, Selection_Change olayı işlemek istemedim, eğer daha fazla iş gerekebilir eğer bir kullanıcı anahtar preslenmiş hücreye yolunu.

Çok boyutlu dizilerde bu kadar rahat olmadığınızı belirttiniz. Son boyutu yalnızca yeniden tasarlayabileceğimiz göz önüne alındığında, amaçlarının çalışma sayfasına yazan bir dizi hazırlaması gerektiğinde gerçek bir keman olduklarına katılıyorum. Bu sadece kişisel bir tercihtir, ancak dinamik olarak satır ekleyeceğimi (yani, ilk boyutu artırdığımı) biliyorsanız, farklı bir veri depolama yöntemi (1D dizisi, Collection, Dictionary, vb.) Kullanıyorum ve verileri Yazmadan hemen önce 2d çıkış dizisi. Aşağıdaki kodda örneğin Collection kullanıyorum.senin Çalışma arkasında kodunda

Option Explicit 
Private mChanges As Collection 
Public Sub Test() 
    Dim ws As Worksheet 
    Dim output() As String 
    Dim logItems As Variant 
    Dim i As Long 

    'Log some changes 
    Set ws = ThisWorkbook.Worksheets("Sheet2") 
    Set mChanges = New Collection 
    LogChanges ws.Range("A1"), "Test1" 
    LogChanges ws.Range("A2"), "Test2" 
    LogChanges ws.Range("A3"), "Test3" 

    'Populate the output array 
    ReDim output(1 To mChanges.Count + 1, 1 To 2) 
    output(1, 1) = "Cells": output(1, 2) = "Changes Made" 
    i = 2 
    For Each logItems In mChanges 
     output(i, 1) = logItems(0) 
     output(i, 2) = logItems(1) 
     i = i + 1 
    Next 
    'Write output to sheet 
    ws.Range("A1:B1").Resize(UBound(output, 1)).Value = output 
    'Select cell "A1" so any cell click below "A1" can be captured 
    ws.Activate: ws.Range("A1").Select 

End Sub 

Private Sub LogChanges(cell As Range, reason As String) 
    Dim logItems(0 To 1) As String 

    logItems(0) = cell.Address(False, False) 
    logItems(1) = reason 
    mChanges.Add logItems 
End Sub 

:

bir modülde

adresleri ile hücrelerin üzerine yapıştırarak sonra

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    Dim desired As Range 
    Dim cell As Range 

    If Target.Cells.Count = 1 Then 
     Set desired = Me.Range("A2", Me.Cells(Me.Rows.Count, "A").End(xlUp)) 
     If Not Intersect(Target, desired) Is Nothing Then 
      'Check whether the reason is a 'go to' one -> change string as req'd 
      If Target.Offset(, 1).Value2 = "Test2" Then 
       Set cell = Nothing 
       On Error Resume Next 
       'Define the cell address -> amend "Sheet1" to your user sheet name. 
       Set cell = ThisWorkbook.Worksheets("Sheet1").Range(Target.Value2) 
       On Error GoTo 0 
       If Not cell Is Nothing Then 
        'Cell address is valid so go to it. 
        Application.Goto cell, True 
       End If 
      End If 
     End If 
    End If 

End Sub