Spostare/copiare range usando gli array

[patelModeratore patel Karma: 51 pts]

Allego un file di esempio che spiega cosa vorrei ottenere, questo file l'ho copiato dal forum di OpenOffice ed il problema è stato risolto con la seguente macro che non riesco ad adattare al VBA, trovo difficoltà con REDIM PRESERVE.

sub main
	' recupera il documento corrente
	doc = thiscomponent
	' recupera i dati della tabella fissa
	tabella_fissa = doc.NamedRanges.getByName("tabella_fissa").ReferredCells
	dati_fissi = tabella_fissa.DataArray
	' recupera i dati della tabella da inserire
	tabella_nuova = doc.NamedRanges.getByName("tabella_nuova").ReferredCells
	dati_nuovi = tabella_nuova.DataArray
	' il numero dei dati da inserire
	diff = ubound(dati_nuovi)
	' il numero dei dati fissi
	max = ubound(dati_fissi)+1
	' modifica la tabella dei dati fissi ritirando le prime righe
	' ed aggiungendo righe vuote al fondo
	redim preserve dati_fissi(diff+1 to max+diff)
	' riempie le righe vuote con i dati nuovi
	for n = 0 to diff
		dati_fissi(max+n) = dati_nuovi(n)
	next n
	' inserisce la tabella modificata
	tabella_fissa.setDataArray(dati_fissi)
	' cancella i dati aggiunti
	tabella_nuova.clearContents(7)
end sub

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

E' un esercizio o si possono sfruttare i metodi tipici di Excel?
Il risultato va implementato n Excel o in Word?
Posso provarci in concreto o vuoi solo delle dritte? 😀

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Un esempio, ma ho sfruttato i metodi di Excel.

Option Explicit

Sub main_VF()
Dim tabella_fissa As Range
Dim tabella_nuova As Range
Dim tabella_finale As Range

    Set tabella_fissa = Range("tabella_fissa")
    Set tabella_nuova = Range("tabella_nuova")
    
    Set tabella_finale = tabella_fissa.Resize(tabella_fissa.Rows.Count - 5).Offset(5)
    tabella_finale.Copy Range("M2")
    
    tabella_nuova.Copy Cells(Range("M2").CurrentRegion.End(xlDown).Row + 1, "M")
End Sub

Più interessante provarci senza, in puro VBA. Adesso provo 🙂

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Mi pare comunque di ricordare che Redim Preserve preserva solo la seconda dimensione. Non si può ridimensionare anche la prima. Ma potrei sbagliare 🙂

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Comunque questa è la proposta in VBA.

Option Explicit

Sub main_VF2()
Dim v1() As Variant
Dim v2() As Variant
Dim w() As Variant
Dim riga As Integer
Dim colonna As Integer
Dim i As Long
Dim j As Long

    Range("M:Q").ClearContents
    v1 = Range("tabella_fissa")
    v2 = Range("tabella_nuova")
    ReDim w(UBound(v1, 1) + UBound(v2, 1), UBound(v1, 2)) As Variant
    
    i = UBound(v1, 1) - 5
    j = UBound(v1, 2)
    For riga = 1 To i
        For colonna = 1 To j
            w(riga, colonna) = v1(riga + 5, colonna)
        Next
    Next
   
    For riga = i + 1 To i + UBound(v2, 1)
        For colonna = 1 To UBound(v2, 1)
            w(riga, colonna) = v2(riga - i, colonna)
        Next
    Next
    
    '---------------------------------------------------
    For riga = 2 To 2 + UBound(w, 1) - 1
        For colonna = 1 To UBound(w, 2)
            Cells(riga, colonna + 12) = w(riga - 1, colonna)
        Next
    Next
    
End Sub

Allegati:

You must be logged in to view attached files.

[patelModeratore patel Karma: 51 pts]

Ottimo lavoro, mi sembra più interessante la prima soluzione, mentre se si usano gli array il basic do OO mi sembra più efficace

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Forse perché per strafare ho riempito un array dimensionandolo con la massima dimensione (derivata dall'unione delle due tabelle originali), poi ho spazzolato le tabelle per riversare nell'array il loro contenuto e infine ho copiato tutto in Excel. Di sicuro è poco performante (l'array ha un sacco di spazio sprecato che nel foglio Excel non si nota perché svuoto le celle di destinazione prima della copiatura).

[scossaPartecipante scossa Karma: 37 pts]

Ciao,

ammesso di aver capito la richiesta:

Sub SpostaConArray()
  Dim vArrDest As Variant
  
  Range("M:Q").ClearContents
  vArrDest = Intersect([tabella_fissa], [tabella_fissa].Offset(5))
  Range("M2:Q11") = vArrDest
  vArrDest = [tabella_nuova]
  Range("M12:Q16") = vArrDest
  
End Sub

Volendo, con due istruzioni, si può aggiungere il colore di fondo:

Sub SpostaConArrayFormat()
  Dim vArrDest As Variant
  
  Range("M:Q").Clear
  vArrDest = Intersect([tabella_fissa], [tabella_fissa].Offset(5))
  Range("M2:Q11") = vArrDest
  vArrDest = [tabella_fissa].Interior.Color
  Range("M2:Q11").Interior.Color = vArrDest
  vArrDest = [tabella_nuova]
  Range("M12:Q16") = vArrDest
  vArrDest = [tabella_nuova].Interior.Color
  Range("M12:Q16").Interior.Color = vArrDest
End Sub

[albatros54Moderatore albatros54 Karma: 89 pts]

@ scossa

E' un piacere sentirti e leggere il tuo codice  

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[patelModeratore patel Karma: 51 pts]

Grazie Scossa, vedo che quando c'è qualcosa di interessante intervieni sempre e lasci il segno !  

[scossaPartecipante scossa Karma: 37 pts]

Grazie!

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Ciao scossa! Quanto tempo. A ben rileggerti!

 

Nel merito, ovviamente è un piacere imparare da te qualcosa di utile.
Di passaggio aggiungo che spero che vorrai unirti a me nell'iniziativa di rilancio del blog 🙂

[scossaPartecipante scossa Karma: 37 pts]

....Di passaggio aggiungo che spero che vorrai unirti a me nell'iniziativa di rilancio del blog

Ho visto il post in Area51; iniziativa interessante, ma ultimamente non ho più molta voglia di curare l'aspetto "divulgativo". Comunque cercherò di seguirvi di più e se viene qualche spunto .....

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Naturalmente nessuno pretende niente. Andrebbe benissimo anche qualche suggerimento su argomenti particolari da sviscerare 🙂 E questo invito è rivolto a tutti, chiaramente. Con ringraziamenti anticipati 🙂

[patelModeratore patel Karma: 51 pts]

Ciao scossa, perché hai usato Intersect ?

vArrDest = Intersect([tabella_fissa], [tabella_fissa].Offset(5))

invece di

vArrDest =  [tabella_fissa].Offset(5)

[scossaPartecipante scossa Karma: 37 pts]

vArrDest =  [tabella_fissa].Offset(5)

Perché solo con offset avrebbe mantenuto lo stesso numero di righe, quindi includendone alcune di tabella_nuova.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

E' per questo che io avevo dovuto aggiungere Resize. Naturalmente la soluzione di scossa migliora le performances 🙂

[albatros54Moderatore albatros54 Karma: 89 pts]

Allora, ho letto il post.

patel ha scritto:

vArrDest = Intersect([tabella_fissa], [tabella_fissa].Offset(5))

invece di

vArrDest =  [tabella_fissa].Offset(5

ho preso il codice postato da scossa(saluto) è ho modificato la riga

vArrDest = Intersect([tabella_fissa], [tabella_fissa].Offset(5))

con quella postata da patel(saluto) per vedere l'effetto che fa  

il risultato è sempre lo stesso , sia con scossa che con patel.

forse ho sbagliato qualcosa?

 

 

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

E' diverso il risultato della selezione. Intersect mantiene il range originale, senza le prime righe; la seconda versione semplicemente sposta in avanti il range di cinque righe estendendosi alle righe sottostanti.

Prova in finestra immediata le due istruzioni (con aperto il file ovviamente) e vedi l'effetto che fa 🙂 

prova 1:  Intersect([tabella_fissa], [tabella_fissa].Offset(5)).Select

prova 2:  [tabella_fissa].Offset(5).select

[albatros54Moderatore albatros54 Karma: 89 pts]

guarda che  ho sostituito sul codice postato da scossa solamente  la riga con

questa

[tabella_fissa].Offset(5)

 

e  il risultato è quello che risulta la lanciando il codice di scossa.

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Sì, l'ho provato anche io e il risultato è uguale 🙂
Magari scossa ha una risposta più tecnica. O magari è solo simpatia per Intersect 🙂

[scossaPartecipante scossa Karma: 37 pts]

Ciao, 

temevo che il WD40 non avesse eliminato la ruggine dalle mie "celluline grigie" (cit. Poirot), ma fortunatamente ....:

Provate queste istruzioni nella finestra immediata:

?[tabella_fissa].Address
$A$2:$E$16

?[tabella_fissa].Offset(5).Address
$A$7:$E$21

?Intersect([tabella_fissa], [tabella_fissa].Offset(5)).Address
$A$7:$E$16

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Quindi è come dicevo io, solo che all'atto pratico, con l'assegnazione all'array di destinazione al termine del suggerimento di scossa, la differenza non c'è perché scossa imposta un range preciso di destinazione di vArrdest:

  Range("M2:Q11") = vArrDest
...
  Range("M12:Q16") = vArrDest

limitando l'output alle sole celle con dati.

[albatros54Moderatore albatros54 Karma: 89 pts]

Quindi:

la riga di codice è una array  che va da $A$7:$E$21

[tabella_fissa].Offset(5).Address
$A$7:$E$21

solo che al momento di inserla dato che il range è

Range("M2:Q11")

non inserisce le ultime  rige che compongono l'array che vanno da

$A$7:$E$21

se ho capito.

 

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Ecco, dovrebbe essere l'interpretazione corretta 🙂

[Autore]

Articoli