as unidimensionais não mexo com realocação de valores, mas mesmo assim é um ponto para futuras utilizações
bem fernando vamos lá
como falei eu uso pq funcionou para mim
deixaria de usar caso encontrasse alternativa sem que leve para uma complicação de minhas macros ?
sim
olha as variaveis publicas que uso
SetorL é a macro que é chamada pelas outras macros para definir as variaveis de posição dos setores
'Locais ou Setores
Public Const Plan_Fixa = "Fixa"
Global Const TabelaSetores = "A10:P32"
Public Const AbAux = "AUXIa"
Public ColunO() As Variant
Public ColunD() As Variant
Public Not_Setor As Long '-----------retorna que setor não existe
Public Naba As String '-----------indica Nome daba origem
Public frL(1 To 15) As Byte '-----Valores auterados a cada execução
Public frC(1 To 15) As Byte '---Valores auterados a cada execução
Public frLs(1 To 15) As Byte '-----Valores auterados a cada execução
Public frCd(1 To 15) As Byte '---Valores auterados a cada execução
Public Rang As String 'range de setor Total
Public RangT As String 'range de setor Total
Public RangD As String 'range de setor Dados
Public Ti As String 'Coluna titulo
Public Cd As String 'Coluna Data
Public iC As String
Public Ci As String 'Coluna inicial
Public Cf As String 'Coluna final
Public Fc As String 'colunas suplementares (Formulas e afins)
Public Ff As String
Public Li As Long 'linha inicial
Public Lf As Long 'Linha final
Public nST As String 'indica Nome do Setor
Public nSTo As String 'indica Nome do Setor de ORIGEM
Public Cq As Long 'indica quantidade de colunas do setor
Public CqT As Long 'indica quantidade Total de colunas do setor
Public CqO As Long 'indica quantidade de colunas do setor de ORIGEM
Public CqD As Long 'indica quantidade de colunas do setor de Destino
Public nP As String 'informa de qual plan se origina os dados
Public nPo As String 'informa de qual plan se origina o setor
Public nPi As String 'informa de qual plan se origina a Aba
Public Ord As Byte 'informa ordem na planilha
Public Cor1 As Long
Public Cor2 As Long
Public CorSt(1 To 3, 1 To 2) As Long
'------------------------------------------( Macros Pincipais )--------------------
Sub SetorL(ByVal Setor_Nome_ou_Numero As Variant, Optional ByVal Nome_aba As String) ', Optional Nome_pasta_trabalho As String)
Dim arr() As Variant
If Nome_aba = "" Then Nome_aba = ActiveSheet.Name 'Planilha Ativa
Sheets(Nome_aba).Range(TabelaSetores).Calculate
arr = Sheets(Nome_aba).Range(TabelaSetores).Value2
If Setor_Nome_ou_Numero > 0 And Setor_Nome_ou_Numero < 16 Then
k = Setor_Nome_ou_Numero
Else
For k = 1 To UBound(arr, 2) '15
If arr(3, k) = Setor_Nome_ou_Numero Then GoTo setx 'Exit For
Next
GoTo fim
End If
setx:
Ti = arr(5, k) '.Cells(14, K).Value2'------------------------------coluna de titulos ou index ( Primeira Coluna Do Setor )
Cd = arr(6, k) '.Cells(15, K).Value2' -------------------------coluna de datas
iC = arr(7, k) ' .Cells(16, K).Value2'---------------------ultima coluna fixa do setor
Ci = arr(8, k) '.Cells(17, K).Value2'----------------Coluna inicial dados
Cf = arr(9, k) '.Cells(18, K).Value2'------------Coluna final dados
Fc = arr(10, k) '.Cells(19, K).Value2'------Coluna de função do setor "Fixa"
Li = arr(1, 5) '.Cells(22, K).Value2
Lf = arr(1, 6) '.Cells(23, K).Value2
'----------------------------------------------------------------------------------------------------------------------------------------
nPi = arr(1, 3) '.Cells(10, 2).Value2 '-------------------------------Nome da Aba de origem dos dados
nP = arr(1, 2) '.Cells(10, 2).Value2 '---------------------------Nome da Aba atual
nST = arr(3, k) '.Cells(12, K).Value2 '------------------indica Nome do Setor
Ord = arr(4, k) '.Cells(13, K).Value2'----------------indica porssicao na planilha
'----------------------------------------------------------------------------------------------------------------------------------------
Cq = arr(11, k) '.Cells(20, K).Value2 '------------quantidade colunas de dados moveis do setor
CqT = Cq + 3 '---------------------------------------quatidade total de colunas do setor
'----------------------------------------------------------------------------------------------------------------------------------------
Cor1 = arr(17, k) '.Cells(26, K).Value2 'Cores do Setor
Cor2 = arr(18, k) '.Cells(27, K).Value2
'----------------------------------------------------------------------------------------------------------------------------------------
Not_Setor = 0
Exit Sub
fim:
Not_Setor = 1
MsgBox "Setor " & Setor_Nome_ou_Numero & " não existe em " & Nome_aba
End Sub
'************************ Ajusta quantidade de Colunas ***********************************************
Sub ColunasN(ByVal Quantidade_de_Colunas As Long, Optional Nome_aba As String) '(ByVal Nome_SETOR As String,
If Limit = 1 Then MsgBox "Execução Proibida": Exit Sub
If Nome_aba = "" Then Nome_aba = ActiveSheet.Name
Dim Ma As Long, N As Long
Ma = Quantidade_de_Colunas
With Sheets(Nome_aba)
.Range(TabelaSetores).Calculate
If Limit(1) <> "AUXIa" Then Desformata
If Ma > 2 Then
Cf1 = Let_Num_Col(Cf) 'Range(Cf & "1").Column
If Cq < Ma Then '--------------------------------------------------------------------------( insere colunas )--------
N = Ma - Cq
.Range(.Cells(6, Cf1 + 1), .Cells(1, Cf1 + N)).EntireColumn.Insert
.Range(.Cells(6, Cf1 - 1), .Cells(12, Cf1)).AutoFill Destination:=.Range(.Cells(6, Cf1 - 1), .Cells(12, Cf1 + N)), Type:=xlFillDefault ' Espande Formulas
Cf = Letra_Col(Cf1 + N): Fc = Letra_Col(Cf1 + N + 1)
End If
If Cq > Ma Then ' ------------------------------------------------------------------------( deleta colunas )--------
N = Cq - Ma - 1
.Range(.Cells(6, Cf1 - N), .Cells(1, Cf1)).EntireColumn.Delete
Cf = Letra_Col(Cf1 - (N + 1)): Fc = Letra_Col(Cf1 - N)
End If
Cq = Ma
End If
.Range(TabelaSetores).Calculate
If Limit(1) <> "AUXIa" Then Reformata
End With
End Sub
algumas macros simples que trocam e copiam setores de uma para outro
estão meio bagunçado pq fiz algumas mudanças para adicionar novas funcionalidades como trocar as cores dos setores , ainda não está como eu quero
Sub Reseta(ByVal SetorX As Variant)
Call SetorL(SetorX)
If PlanExiste(nPi) <> 1 Then nPi = Plan_Fixa
Call Copia_SetorO(SetorX, nPi)
CorSt(1, 1) = Cor1
CorSt(1, 2) = Cor2
Call Colar_Setor(SetorX, ColunO)
Cells(26, Ord).Value2 = CorSt(1, 1)
Cells(27, Ord).Value2 = CorSt(1, 2)
formatacor
End Sub
Sub Espelhamento(ByVal numeroSetor As Byte)
Call Copia_SetorO(numeroSetor)
Call Espelhar(ColunO, 1)
Call Colar_Setor(numeroSetor, ColunO)
End Sub
Sub TrocarTeste()
If Limit = 1 Then Exit Sub
Inicio
Call Troca_Setor(2, 5, 1)
Final
End Sub
'-----------( Troca os dados de um Setor com os Dados de Outro Setor )---*
Sub Troca_Setor(ByVal SetorX1 As Variant, ByVal SetorX2 As Variant, Optional ByVal Cor_fotr As Long)
If Limit = 1 Then Exit Sub
Inicio
Call Copia_SetorO(SetorX1)
nomest1 = Cells(1, Ci).Value2
Call Copia_SetorD(SetorX2)
nomest2 = Cells(1, Ci).Value2
Call Colar_Setor(SetorX2, ColunO)
Cells(1, Ci).Value2 = nomest1
Range(TabelaSetores).Calculate
If Cor_fotr = 1 Then
Cells(26, Ord).Value2 = CorSt(1, 1)
Cells(27, Ord).Value2 = CorSt(1, 2)
formatacor
End If
Call Colar_Setor(SetorX1, ColunD)
Cells(1, Ci).Value2 = nomest2
Range(TabelaSetores).Calculate
If Cor_fotr = 1 Then
Cells(26, Ord).Value2 = CorSt(2, 1)
Cells(27, Ord).Value2 = CorSt(2, 2)
formatacor
End If
Final
End Sub
'-----------( Copia os dados de um SetorOrigem "pode ser de outra planilha" em um SetorDestino na planilha ativa )---****
Sub Copia_SetorO(ByVal SetorOrigem As Variant, Optional ByVal Nome_aba As String)
If Nome_aba = "" Then Nome_aba = ActiveSheet.Name
Call SetorL(SetorOrigem, Nome_aba)
Rang = Ti & Li & ":" & Fc & Lf 'Range total do setor
ColunO = Sheets(Nome_aba).Range(Rang).Value2
CqO = Cq
CorSt(1, 1) = Cor1
CorSt(1, 2) = Cor2
End Sub
Sub Copia_SetorD(ByVal SetorOrigem As Variant, Optional ByVal Nome_aba As String)
If Nome_aba = "" Then Nome_aba = ActiveSheet.Name
Call SetorL(SetorOrigem, Nome_aba)
Rang = Ti & Li & ":" & Fc & Lf 'Range total do setor
ColunD = Sheets(Nome_aba).Range(Rang).Value2
CqD = Cq
CorSt(2, 1) = Cor1
CorSt(2, 2) = Cor2
End Sub
Sub Colar_Setor(ByVal SetorDestino As Variant, ByRef NomeArray As Variant, _
Optional ByVal linha_inicial As Long, Optional ByVal Nome_aba As String)
If Nome_aba = "" Then Nome_aba = ActiveSheet.Name
If Limit = 1 Then MsgBox "Execução Proibida": Exit Sub
Dim Qc As Long
Qc = UBound(NomeArray, 2) - 4
Call SetorL(SetorDestino, Nome_aba)
If Cq <> Qc Then
Call ColunasN(Qc, Nome_aba)
End If
'Lf = ULinhaRange(Ti, Fc)
Sheets(Nome_aba).Range(Ti & Li, Fc & Lf).ClearContents
If linha_inicial > 0 Then Li = linha_inicial
Lf = Li + UBound(NomeArray, 1) - 1
Sheets(Nome_aba).Range(Ti & Li, Fc & Lf).Value2 = NomeArray
End Sub
são apenas algumas, eu penso em melhorar e muito as macros
mas ainda preciso definir uma estrutura definitiva para a planilha
Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.
"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"