Ir ao conteúdo
  • Cadastre-se

Midori

Membro Pleno
  • Posts

    3.543
  • Cadastrado em

  • Última visita

Tudo que Midori postou

  1. @Jmbs Veja se assim resolve, Sub MacroAlteraMinuto() Call AlteraMinuto([F10:F25]) Call AlteraMinuto([L10:L25]) End Sub Sub AlteraMinuto(Area As Range) Dim Hora As Range For Each Hora In Area Hora.Value = _ Left(Hora.Value, 2) & ":" & _ Format(Int(Rnd() * 10), "00") Next Hora End Sub
  2. Faltou a função. Function BuscaNota(Tabela As Range, ByVal Setor As String, ByVal Lider As String) As Double Const COL_SETOR As Integer = 1 Const COL_LIDER As Integer = 2 Const COL_NOTA As Integer = 3 Dim Area As Range If Tabela.Worksheet.AutoFilterMode = True Then Call Tabela.Rows(1).AutoFilter End If Call Tabela.Rows(1).AutoFilter(Field:=COL_SETOR, Criteria1:=Setor) Call Tabela.Rows(1).AutoFilter(Field:=COL_LIDER, Criteria1:=Lider) Set Area = Tabela.SpecialCells(xlCellTypeVisible) If Area.Areas.Count > 1 Then BuscaNota = Area.Areas(2)(COL_NOTA).Value ElseIf Area.Rows.Count > 1 Then BuscaNota = Area(2, COL_NOTA).Value Else BuscaNota = -1 End If End Function
  3. @ppeterk A macro vai pegar o caminho do arquivo na coluna 4 e aplicar o filtro para Setor e Lider. O retorno da função será o valor da nota da primeira filtrada. Sub MacroBuscaNota() Const COL_SETOR As Integer = 1 Const COL_LIDER As Integer = 2 Const COL_NOTA As Integer = 3 Const COL_DIR As Integer = 4 Dim Base As Range Dim Arquivo As Workbook Dim Linha As Long Dim Nota As Double Set Base = ThisWorkbook.ActiveSheet.[A1].CurrentRegion For Linha = 1 To Base.Rows.Count If Dir(Base(Linha, COL_DIR).Value) <> "" Then Set Arquivo = Workbooks.Open(Filename:=Base(Linha, COL_DIR).Value) Nota = BuscaNota( _ Arquivo.ActiveSheet.[A1].CurrentRegion, _ Base(Linha, COL_SETOR).Value, _ Base(Linha, COL_LIDER).Value) If Nota >= 0 Then Base(Linha, COL_NOTA).Value = Nota End If Call Arquivo.Close(False) End If Next Linha End Sub
  4. A importação pode ser feita individualmente. Em vez de escolher "Da Pasta" pode ser "Da Pasta de Trabalho". Em Carregar Para > Importar Dados selecione Apenas Criar Conexão. Vai ficar assim, Depois é só juntar tudo numa tabela, se clicar com o direito sobre uma tabela verá a opção. Aqui é Append, Com fórmula dá para passar o diretório a partir de uma célula com indireto, mas se fechar a planilha vai dar erro na fórmula. Com macro é possível fazer uma busca nos diretórios para abrir a planilha e atualizar os dados na ativação de algum evento (botão ou change talvez).
  5. @ppeterk Talvez o recurso que combina múltiplos arquivos ajude. Em Obter Dados > De Arquivo > Da Pasta. Selecione a pasta onde estão apenas os arquivos "Andar" e depois Combinar e Carregar. A tabela fica assim, Dessa forma é só atualizar a tabela para buscar os dados atualizados de qualquer arquivo. Se um novo arquivo no mesmo padrão for criado na pasta, os registros serão atualizados na tabela. Para puxar dados mais específicos você pode criar outra tabela na planilha para buscar nessa.
  6. @Rangel Salomé Acho mais simples fazer da forma como comentei, é só adicionar o Shape na planilha (Insert > Illustrations > Shapes > Rectangle) e carregar a imagem nele. Para carregar a imagem ao entrar com o código em B3, a macro pode ser ativada no evento Change da planilha assim, Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$3" Then Dim Arquivo As String Arquivo = "C:\Fotos\" & Target.Value & ".png" Call Me.Shapes("Imagem").Fill.UserPicture(Arquivo) End If End Sub Esse procedimento deve ficar no módulo da Planilha. Veja que o nome do Shape aí é Imagem e do diretório C:\Fotos, no seu caso de vem ser outros. Faça um teste e se der certo você pode adicionar On Error Resume Next para não mostrar uma mensagem no caso de um erro de digitação ou se uma imagem específica não for encontrada.
  7. @Rangel Salomé Com Shape é só passar o caminho da imagem para o procedimento UserPicture, p.ex, Dim Imagem As Shape Set Imagem = ActiveSheet.Shapes("Imagem") Call Imagem.Fill.UserPicture("C:\Foto\" & [B3].Value & ".png") Assim a imagem sempre será substituída.
  8. Na operação numerador1/denominador1 o resultado será int já que as duas variáveis são desse tipo. O cast serviu para tratar/converter um tipo para outro e nesse caso foi float (de int para float). A sintaxe é (tipo)expressão. Assim o resultado não será truncado já que com (float)denominador1 a operação será entre int e float e o resultado float.
  9. @rafaznj Seu codigo tem que acumular a soma de cada termo. E veja que o sinal tambem muda, positivo para o primeiro, negativo para o segundo termo e assim por diante. Ha mais de uma forma de trocar o sinal a cada ciclo, uma delas e elevando -1 ao contador (funcao pow de <cmath>). Assim quando for par sera positivo e impar negativo, p.ex, soma += (numerador1 / (float)denominador1 - numerador2/denominador2) * pow(-1, i - 1); Seu resultado retorna zero por causa da divisao entre valores/tipos inteiros. Com cast (float) o resultado da operacao sera com valores decimais.
  10. Consegui resolver atribuindo tudo para CFLAGS, assim compila sem erro, INCDIR = -I/usr/local/include -I./regexp/include -I./xg/include DEFINES = -D__NetBSD__ -DFreeBSD CFLAGS += -O3 -Wall -lXm -lXpm -lXt -lICE -lSM -lXmu -lX11 CFLAGS += ${DEFINES} ${INCDIR} Como o meu sistema não tem <alloca.h> tenho que configurar essas macros para não adicionar esse header. Veja que especificamente para isso tambem poderia ser _AIX ou hpux, porém a outra macro faz mais sentido para o meu caso. não e necessario resolver essa dependencia com a outra condicao da diretiva #pragma alloca.
  11. Criei um Makefile para compilar um pacote e acontece alguns erros, este e um deles, ./xplore.h:32:10: fatal error: 'alloca.h' file not found #include <alloca.h> ^~~~~~~~~~ 1 error generated. Veja que o motivo e a falta de alloca.h no meu sistema, porém no xplore.h tem umas macros para tratar isso, esta e a linha do erro, 23 #ifdef _AIX 24 #pragma alloca 25 #else 26 #ifdef hpux 27 #pragma alloca 28 #else 29 #ifdef __NetBSD__ 30 #pragma alloca 31 #else 32 #include <alloca.h> 33 #endif /* __NetBSD__ */ 34 #endif /* hpux */ 35 #endif /* _AIX */ Se eu colocar p.ex #define __NetBSD__ em xplore.h resolvo esse erro, mas tem outros arquivos com essas macros. Como posso fazer isso no Makefile para não ter que editar cada arquivo? Vi que daria para para fazer algo com -D. Mas tentei -D__NetBSD__ e não deu certo, Qual e a forma correta? Uma parte do meu Makefile, CC = clang LIBDIR = -L/usr/local/lib -L./regexp -L./xg INCDIR = -I/usr/local/include DEFINES = -D__NetBSD__ -DNetBSD -DFreeBSD CFLAGS = -O3 -Wall -lXm -lXpm -lXt -lICE -lSM -lXmu -lX11 ... all: ${APP} ${APP}: ${OBJS} ${CC} ${DEFINES} ${CFLAGS} ${OBJS} ${INCDIR} ${LIBDIR} -o ${APP} Outra questão, como faco para incluir um diretorio de headers para que os fontes *.c encontrem ele com #define <header.h> em vez de #include "header.h"? Tentei passar o diretorio para INCDIR e não deu certo, p.ex: -I./xg/include.
  12. @williams.matos O arquivo "ArquivoTeste.csv" será criado no mesmo diretório onde a planilha foi salva
  13. Salve a planilha com a extensão xlsm. Para executar a macro abra o módulo (pode ser com Alt+F11) onde colou o código e digite F5.
  14. @MateusAC3 Isso pode ser feito desta forma, Sub FormataBorda() Dim Linha As Range For Each Linha In [A1].CurrentRegion.Offset(2).Rows If Linha(0).Columns(4).Value <> _ Linha(1).Columns(4).Value Then Linha.Borders(xlEdgeTop).Weight = xlThick End If Next Linha End Sub
  15. @Juliana Gonçalves Para isso você pode usar o Solver. Pela quantidade de dados da sua tabela deve demorar para rodar. https://support.microsoft.com/pt-br/office/definir-e-resolver-um-problema-usando-o-solver-5d1a388f-079d-43ac-a7eb-f63e45925040
  16. @Juliana Gonçalves Os valores dos saldos das duas planilhas estão iguais... Eles não deviam mudar após rodar a macro? Se sim, como deveriam ficar? No comentário anterior você falou sobre "adicionar outras células que se encaixasse no valor limite". Isso não foi feito na planilha "Como deve ficar". Por que o "peso do load" numa está 977720 e na outra 1000000? Algumas células que estão coloridas em uma planilha não estão na outra. Isso devia significar algo?
  17. @Miguelriedel Você pode aplicar a mesma lógica com as funções correspondentes em VBA: Mid, Len e InStr.
  18. @williams.matos Veja se assim resolve, o arquivo será salvo no mesmo diretório da planilha, Sub CriaArquivoCSV() Dim Tabela As ListObject Dim Registro As Range Dim StrLinha As String Dim ID As String Dim ArquivoCSV As Integer Set Tabela = ThisWorkbook.Sheets("Planilha1").[Tabela2].ListObject ArquivoCSV = FreeFile Open ThisWorkbook.Path & "\ArquivoTeste.csv" For Append As ArquivoCSV If Not Tabela.DataBodyRange Is Nothing Then ID = Tabela.DataBodyRange.Rows.Cells(1, 1).Value For Each Registro In Tabela.DataBodyRange.Rows If ID <> Registro.Columns(1).Value Then Print #ArquivoCSV, ID & StrLinha StrLinha = "" End If StrLinha = StrLinha & ";" & Registro.Columns(4).Value ID = Registro.Columns(1).Value Next Registro End If Close ArquivoCSV End Sub
  19. @Juliana Gonçalves Se possível anexe uma planilha, pode ser com dados fictícios, mostrando um antes e depois (como deve ficar).
  20. Seu código vai dobrando os valores a cada célula. Quando passar do limite qual deve ser o método de soma? Pode mostrar um exemplo na planilha de como deve ficar?
  21. Da mesma forma que atribuiu a última linha para a variável UltimaLinha, você pode fazer o mesmo para LinhaRM. Em vez do valor 2 faça a atribuição ...End(xlUp).Row + 1.
  22. @Guilherme Stoduto No seu primeiro código só faltava o contador para as linhas do relatório. Sub InserirDados() Dim CodMaterial As String Dim Descricao As String Dim QuantidadeSolicitada As Long Dim SaldoEstoque As Long Dim Chapa As String Dim Supervisor As String Dim CodPessoa As Long Dim Segmento As String Dim LocalidadeDestino As String Dim CentroCusto As String Dim Retirada As String Dim Data As String Dim DC As String Dim UltimaLinha As Long Dim I As Long Dim Linha As Long Dim Coluna As Integer Dim LinhaRM As Long Coluna = 1 Linha = 6 LinhaRM = 2 UltimaLinha = Sheets("REQUISIÇÃO").Range("A" & Rows.Count).End(xlUp).Row For I = 6 To UltimaLinha Chapa = Sheets("REQUISIÇÃO").Range("A2") Supervisor = Sheets("REQUISIÇÃO").Range("B2") CodPessoa = Sheets("REQUISIÇÃO").Range("D2") Localidade = Sheets("REQUISIÇÃO").Range("A4") Segmento = Sheets("REQUISIÇÃO").Range("E2") CentroCusto = Sheets("REQUISIÇÃO").Range("B4") Retirada = Sheets("REQUISIÇÃO").Range("D4") Data = Sheets("REQUISIÇÃO").Range("E4") CodMaterial = Sheets("REQUISIÇÃO").Range("B" & I) Descricao = Sheets("REQUISIÇÃO").Range("C" & I) QuantidadeSolicitada = Sheets("REQUISIÇÃO").Range("E" & I) SaldoEstoque = Sheets("REQUISIÇÃO").Range("D" & I) DC = Sheets("REQUISIÇÃO").Range("A" & I) Sheets("RM").Activate Sheets("RM").Range("B" & LinhaRM) = CodMaterial Sheets("RM").Range("C" & LinhaRM) = Descricao Sheets("RM").Range("D" & LinhaRM) = QuantidadeSolicitada Sheets("RM").Range("E" & LinhaRM) = SaldoEstoque Sheets("RM").Range("F" & LinhaRM) = Chapa Sheets("RM").Range("G" & LinhaRM) = Supervisor Sheets("RM").Range("H" & LinhaRM) = CodPessoa Sheets("RM").Range("I" & LinhaRM) = Segmento Sheets("RM").Range("J" & LinhaRM) = LocalidadeDestino Sheets("RM").Range("K" & LinhaRM) = CentroCusto Sheets("RM").Range("L" & LinhaRM) = Retirada Sheets("RM").Range("M" & LinhaRM) = Data Sheets("RM").Range("N" & LinhaRM) = DC LinhaRM = LinhaRM + 1 Next I End Sub
  23. @mcoumiotis Aplique a fórmula N para retornar o valor dessas células, =N(INDIRETO(A2:A75 & "_RxD!A2"))
  24. O mercado abre às 10h, isso não está relacionado com o horário dos registros na planilha? Como comentei, a atualização que ativa o evento Calculate e chama a Sub da AtualizaCotacao. Então veja se antes desse horário acontece alguma atualização nas fórmulas da planilha.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

 

GRÁTIS: ebook Redes Wi-Fi – 2ª Edição

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!