Soru Vba Union Dizi yardım

[FERAZ]

Evet,Sayfa1 deki verileri alıyor.
Sonsat değişkeni için.

sheets("Sayfa1").Range("A3:A" & sonsat & ",B3:B" & sonsat & ",C3:C" & sonsat)

Böyle olacağını hiç düşünmemiştim
Yani her aralığın başına range ekliyordum.

 

[Orion1]

Birde zaten denemede bu kodla alınan verilerde diziye aktarırken tümü aktarılmıyordu.Kafamı karıştırdınız iyice
Benim sorunum dizi içe alırken tüm verilerin alınması döngüsüz.Yoksa union ilede oluyor aynı yöntem

Verilen aralıktaki veriler aktarılır.Belki de dikkat etmediniz.

 

[FERAZ]

Tamam bugün iyice bir deneyeceğim özelliklede son kodu.Sağolunuz.

 

[FERAZ]

Buyurun.

Set alan = sheets("Sayfa1").Range("A3:A6,A10:A13,A16:A20")

Dim alan As Range
    
Hocam kodu alttaki gib yapınca tek seferde hepsini aktarmıyor.
Bunu nasıl hallederiz.

Alttaki örnek kodda hep range içine bir range daha ekliyordum,sayenizde bu olaydan kurtulduk.

    [B:B] = Empty
    Set alan = Sheets("Sayfa1").Range("A3:A6,A10:A13,A16:A20")
    Range("B3").Resize(500, 1) = alan.Value

 

[Orion1]

Dim alan As Range
  
Hocam kodu alttaki gib yapınca tek seferde hepsini aktarmıyor.
Bunu nasıl hallederiz.

Alttaki örnek kodda hep range içine bir range daha ekliyordum,sayenizde bu olaydan kurtulduk.

    [B:B] = Empty
    Set alan = Sheets("Sayfa1").Range("A3:A6,A10:A13,A16:A20")
    Range("B3").Resize(500, 1) = alan.Value

Buyurun.

Set alan = Sheets("Sayfa1").Range("A3:A6,A10:A13,A16:A20")
ReDim arr(1 To 500, 1 To 1)
For Each veri In alan

        say = say + 1
        arr(say, 1) = veri
    Next
 
    [B:B] = Empty
    Range("B3").Resize(say, 1) = arr

    Set alan = Nothing: Set veri = Nothing: Erase arr

 

[FERAZ]

Buyurun.

Set alan = Sheets("Sayfa1").Range("A3:A6,A10:A13,A16:A20")
ReDim arr(1 To 500, 1 To 1)
For Each veri In alan

        say = say + 1
        arr(say, 1) = veri
    Next

    [B:B] = Empty
    Range("B3").Resize(say, 1) = arr

    Set alan = Nothing: Set veri = Nothing: Erase arr

Abey tek seferde döngüsüz olma olasılığı yüzde kaç

 

[Orion1]

Abey tek seferde döngüsüz olma olasılığı yüzde kaç

Bu şekilde olur.En hızlısı.

 

[Suskun]

Alternatif

    Dim alan As Range
    Set alan = Union(Range("A3:A6"), Range("A10:A13"), Range("A16:A20"))
    'Set alan = Range("A3:A6,A10:A13,A16:A20")
    alan.Select
    '[B:B] = Empty
    Range("B3:B503").ClearContents
    Selection.Copy Range("B3")
    Set alan = Nothing

 

[FERAZ]

Alternatif

    Dim alan As Range
    Set alan = Union(Range("A3:A6"), Range("A10:A13"), Range("A16:A20"))
    'Set alan = Range("A3:A6,A10:A13,A16:A20")
    alan.Select
    '[B:B] = Empty
    Range("B3:B503").ClearContents
    Selection.Copy Range("B3")
    Set alan = Nothing

Teşekkürler @Suskun hocam.Kodunuzu biraz daha düzenmedim.

 Dim alan As Range
    
    Set alan = Sheets("Sayfa1").Range("A3:A6,A10:A13,A16:A20")
    Range("B3:B" & Rows.Count).ClearContents
    alan.Copy Range("B3")
    Application.CutCopyMode = False
    Set alan = Nothing

 

[FERAZ]

Bu şekilde olur.En hızlısı.

Teşekkürler @Orion1 hocam.
Evet çok hızlı oldu.Mantık açısından tek seferde istemiştim. @Suskun hocamızınkide oldu bu şekilde.Yani bayağı birşeyler öğrendim sayenizde.

 

[Haluk]

Şöyle bir şey işinize yarar mı?

Sub Test()
    Sheets("Sayfa1").Range("A3:A6,A10:A13,A16:A20").Copy Destination:=Range("B3")
End Sub

.

 

[FERAZ]

Sağolunuz hocam hertürlü oluyor.
Sadece merak ettiğim alttaki gibi neden olmuyor.Föngüye girince tüm veriler geliyor fakat topluca olmuyor.

Set alan = Sheets("Sayfa1").Range("A3:A6,A10:A13,A16:A20")
    Range("B3").Resize(alan.count, 1) = alan.Value

 

[FERAZ]

Range("B3").Resize(alan.count, 1).value = alan.Value

Birde müsait olunca .value eklenmiş haliyle deneyeyim ne olacak sonuç.