Diziler/koleksiyonlar ve her döngü için kullanıcı tanımlı türleri

Question

VBA, kullanıcı tanımlı türlerde bir dizi boyunca yineleme yapmama izin vermediğini gösteren bir açılır pencerede gösterir. Biraz kod yazdım ve bu konuda nasıl çalışabileceğimi merak ediyorum. İşte yapmak istediklerime odaklanan küçük bir örnek.

Option Explicit 

Type Info 
    source As String 
    destination As String 
End Type 

Sub specialCopy() 
    Dim target As Variant 
    Dim AllTargets() As Info: AllTargets = SetAllTargets() 
    For Each target In AllTargets 
     CopyValues (target) 
    Next 
End Sub 

Function SetAllTargets() As Info() 
    Dim A As Info: A = SetInfo("A1", "B1") 
    Dim B As Info: B = SetInfo("A2", "B2") 
    Dim AllTargets() As Info 
    Set AllTargets = Array(A, B) 
End Function 

Function SetInfo(source As String, target As String) As Info 
    SetInfo.source = source 
    SetInfo.destination = destination 
End Function 

Sub CopyValues(target As Info) 
    Range(target.source).Select 
    Selection.Copy 
    Range(target.destination).Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
End Sub 

Nasıl benim AllTargets dizi yineleme yapabilirsiniz? Bunu derleyemediğimden, burada birden fazla sorun olabilir. AllTargets listesini ayarladığım yolun geçerli bir sözdizimi olduğundan emin değilim.

---

kod sorunları daraltmak için örnek reworked:

Option Explicit 

Type Info 
    source As String 
    destination As String 
End Type 

Sub specialCopy() 
    Dim target As Variant 
    Dim AllTargets As Collection: Set AllTargets = SetAllTargets() 
    For Each target In AllTargets 
     CopyValues (target) '2. unkown if this is possible 
    Next 
End Sub 

Function SetAllTargets() As Collection 
    Dim A As Info: A = SetInfo("A1", "B1") 
    Dim B As Info: B = SetInfo("A2", "B2") 
    Set SetAllTargets = New Collection 
    SetAllTargets.Add (A) '1. problem here when assigning user type 
    SetAllTargets.Add (B) '1. problem here when assigning user type 
End Function 

Function SetInfo(source As String, destination As String) As Info 
    SetInfo.source = source 
    SetInfo.destination = destination 
End Function 

Sub CopyValues(target As Info) 
    Range(target.source).Select 
    Selection.Copy 
    Range(target.destination).Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
End Sub 

kod Koleksiyonuna Array gitti - asla daha az şimdi çözemediği içinde sorunlar hala var .

Kök nedeninin aynı kaldığını düşünüyorum: kullanıcı tanımlı türler kullanarak. Sorunların yer aldığı bir yorum olarak işaretlendim.

Answer 1

Koleksiyonlara veya sözlüklere UDT ekleyemezsiniz. Nedenini bilmiyorum, ama dilde içseldir. UDT ile aynı şeyi yapan basit bir özel sınıf yapabilirsiniz. Artık UDT'leri asla kullanmam ve sadece bu garip sınırlamaları önlemek için bir sınıf oluşturmam.

Yeni bir sınıf modülü oluşturun (Eklenti Modülü). Özellikler sayfasına gidin (F4) ve ismini CInfo olarak değiştirin. Bir sınıfta

standart bir modül geç kabulü için üzgünüm

Sub specialCopy() 
    Dim target As Variant 
    Dim AllTargets As Collection: Set AllTargets = SetAllTargets() 
    For Each target In AllTargets 
     CopyValues target '2. unkown if this is possible 
    Next 
End Sub 

Function SetAllTargets() As Collection 
    Dim A As CInfo: Set A = SetInfo("A1", "B1") 
    Dim B As CInfo: Set B = SetInfo("A2", "B2") 
    Set SetAllTargets = New Collection 
    SetAllTargets.Add A 
    SetAllTargets.Add B 
End Function 

Function SetInfo(Source As String, Destination As String) As CInfo 
    Set SetInfo = New CInfo 
    SetInfo.Source = Source 
    SetInfo.Destination = Destination 
End Function 

Sub CopyValues(ByRef target As Variant) 
    Range(target.Source).Select 
    Selection.Copy 
    Range(target.Destination).Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
End Sub