AfonsoMira

Boas, Venho solicitar ajuda, para um upgrade na Placa de Vídeo. Setup Atual: Processador: AMD Ryzen 5 3600 3.6 GHz Placa de vídeo: NVIDIA GeForce GTX 1650 4GB Placa-mãe: Motherboard ASUS TUF B450M-PRO S Memória: RAM DDR4 CORSAIR CMW16GX4M2C3200C16 (2 x 8 GB - 3200 MHz - CL 16 - Preto) Fonte: Fonte: 180 W uATX Energy Star 6.0 Estava a pensar atualizar para uma Placa Gráfica ASUS DUAL-RTX3060-O12G-V2 (NVIDIA - 12 GB DDR6) ou então Placa Gráfica MSI GeForce RTX 3060 VENTUS 12G OC (NVIDIA - 12 GB DDR6) Tenho orçamento de 330€ É uma boa escolha ? É necessário atualizar a Fonte ? Se sim que fonte me aconcelham ? Obrigado pela ajuda

Boas @Arthur Guillermo , Com recurso a Macro (VBA) Aqui fica o código, que precisa associar aos Botões. Sub LimparTabela() Dim T As ListObject: Set T = ActiveSheet.ListObjects(1) With T.DataBodyRange If .Rows.Count > 1 Then .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete On Error Resume Next .Rows(1).SpecialCells(xlCellTypeConstants).ClearContents End With End Sub Sub LimparLinhaSelecionada() Dim rng As Range On Error Resume Next With Selection.Cells(1) Set rng = Intersect(.EntireRow, ActiveCell.ListObject.DataBodyRange) On Error GoTo 0 If rng Is Nothing Then MsgBox "Por Favor Selecione a Linha que pretende Eliminar", vbCritical Else If ActiveCell.Row = 2 Then On Error Resume Next Rows(2).SpecialCells(xlCellTypeConstants).ClearContents On Error GoTo 0 Else rng.Delete xlShiftUp End If End If End With End Sub Alguma dúvida disponha.

Boas @isabela queiroz , Seria algo deste género: Sub procura() Windows(" BOM.CO").Activate Cells.Find(What:="PN", After:=ActiveCell, LookIn:=xlValues, LookAt:= _ xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Select ActiveCell.Offset(1, 0).Select 'Define o valor da Variavel valorProcura = ActiveCell.Value Sheets("Pier Distribution").Select 'Procura a variavel Cells.Find(What:=valorProcura, After:=ActiveCell, LookIn:=xlValues, LookAt:= _ xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Select End Sub

Boas, @Miguelriedel Seria algo deste género: Dim NovaTextBox As Control Set NovaTextBox = Me.Controls.Add("Forms.TextBox.1", "NovaTextBoxTeste", True) With NovaTextBox .Width = 90 .Height = 30 .Top = 36 .Left = 66 End With

Boas, @SrMths Isso é possível com recurso a Macro. Veja um exemplo: Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Application.ScreenUpdating = False Dim wb As Workbook: Set wb = ThisWorkbook Dim ws As Worksheet: Set ws = wb.ActiveSheet Dim azul As Range: Set azul = ws.Range("B1") Dim laranja As Range: Set laranja = ws.Range("A1") laranja.Value = laranja.Value + azul.Value azul.Value = "" Application.EnableEvents = True Application.ScreenUpdating = True End Sub

Boas, Penso que assim já resolveria: Sub export_in_json_format() Dim fs As Object Dim jsonfile Dim rangetoexport As Range Dim rowcounter As Long Dim columncounter As Long Dim linedata As String Dim UltimaLinhaAtivaE As Long Dim UltimaLinhaAtivaG As Long Dim UltimaLinhaAtivaH As Long Dim UltimaLinhaAtivaL As Long Dim UltimaLinhaAtivaN As Long Dim UltimaLinhaAtivaO As Long Dim UltimaLinhaAtivaP As Long Dim r1 As Range Dim r2 As Range Dim r3 As Range Dim r4 As Range Dim r5 As Range Dim r6 As Range Dim r7 As Range Dim wb As Workbook: Set wb = ThisWorkbook Dim ws As Worksheet: Set ws = wb.ActiveSheet With ws UltimaLinhaAtivaE = .Cells(.Rows.Count, 5).End(xlUp).Row UltimaLinhaAtivaG = .Cells(.Rows.Count, 7).End(xlUp).Row UltimaLinhaAtivaH = .Cells(.Rows.Count, 7).End(xlUp).Row UltimaLinhaAtivaL = .Cells(.Rows.Count, 12).End(xlUp).Row UltimaLinhaAtivaN = .Cells(.Rows.Count, 14).End(xlUp).Row UltimaLinhaAtivaO = .Cells(.Rows.Count, 15).End(xlUp).Row UltimaLinhaAtivaP = .Cells(.Rows.Count, 16).End(xlUp).Row Set r1 = .Range("N1:N" & UltimaLinhaAtivaN) Set r2 = .Range("O1:O" & UltimaLinhaAtivaO) Set r3 = .Range("P1:P" & UltimaLinhaAtivaP) Set r4 = .Range("H1:H" & UltimaLinhaAtivaH) Set r5 = .Range("G1:G" & UltimaLinhaAtivaG) Set r6 = .Range("L1:L" & UltimaLinhaAtivaL) Set r7 = .Range("E1:E" & UltimaLinhaAtivaE) End With ' change range here Set rangetoexport = Union(r1, r2, r3, r4, r5, r6, r7) Set fs = CreateObject("Scripting.FileSystemObject") ' change dir here Set jsonfile = fs.CreateTextFile("C:\Users\erick.l.santiago\Desktop\" & "jsondata.json", True) linedata = "{""Output"": [" jsonfile.WriteLine linedata For rowcounter = 2 To rangetoexport.Rows.Count linedata = "" For columncounter = 1 To 7 linedata = linedata & """" & rangetoexport.Cells(1, columncounter) & """" & ":" & """" & rangetoexport.Cells(rowcounter, columncounter) & """" & "," Next linedata = Left(linedata, Len(linedata) - 1) If rowcounter = rangetoexport.Rows.Count Then linedata = "{" & linedata & "}" Else linedata = "{" & linedata & "}," End If jsonfile.WriteLine linedata Next linedata = "]}" jsonfile.WriteLine linedata jsonfile.Close Set fs = Nothing End Sub

Sub procurarColunas() Dim wb As Workbook: Set wb = ThisWorkbook Dim ws As Worksheet: Set ws = wb.ActiveSheet Dim rngProcura As Range: Set rngProcura = ws.Range("A1:XFD1048576") Dim rngCliente As Range Dim rngNumero As Range Dim colunaCliente As Long Dim colunaNumero As Long With rngProcura Set rngCliente = .Find(what:="Cliente", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) If Not rngCliente Is Nothing Then colunaCliente = rngCliente.Column End If Set rngNumero = .Find(what:="Numero", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) If Not rngNumero Is Nothing Then colunaNumero = rngNumero.Column End If End With 'Copia coluna Cliente ws.Columns(colunaCliente).Copy 'Copia coluna Numero ws.Columns(colunaNumero).Copy End Sub

Boas @isabela queiroz , Experimente o seguinte: Sub procurarColunas() Dim wb As Workbook: Set wb = ThisWorkbook Dim ws As Worksheet: Set ws = wb.ActiveSheet Dim rngProcura As Range: Set rngProcura = ws.Range("A1:XFD1048576") Dim rngCliente As Range Dim rngNumero As Range Dim colunaCliente As Long Dim colunaNumero As Long With rngProcura Set rngCliente = .Find(what:="Cliente", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) If Not rngCliente Is Nothing Then colunaCliente = rngCliente.Column End If Set rngNumero = .Find(what:="Numero", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) If Not rngNumero Is Nothing Then colunaNumero = rngNumero.Column End If End With MsgBox "A palavra Cliente aparece na coluna " & colunaCliente & " e a palavra Numero na coluna " & colunaNumero End Sub

Boas @isabela queiroz , Desculpe a demora na resposta Veja se assim ajuda: Sub CriarTemplate() 'Declara Variaveis de Livro e Folha Dim wb As Workbook: Set wb = ThisWorkbook Dim ws As Worksheet: Set ws = wb.Sheets("Produto") 'Declara Variavel ultima Linha Dim ultLinha As Long ultLinha = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'Desde a linha 2 até a ultima For i = 2 To ultLinha valor = ws.Cells(i, 1) 'Se "-" existir então If InStr(valor, "-") Then 'Divide valor = Split(valor, "-")(1) 'Remove espaços em branco valor = Trim(valor) If valor = "MALDIVES 6U" Then valor = valor & " " & Left(ws.Cells(i, 1), 3) End If 'Define o valor na célula ws.Cells(i, 2) = valor Else ws.Cells(i, 2).Value = valor End If Next i End Sub

Boas @Scofieldgyn , Veja se isto ajuda: Sub CriarTemplate() 'Declara Variaveis de Livro e Folha Dim wb As Workbook: Set wb = ThisWorkbook Dim ws As Worksheet: Set ws = wb.Sheets("Produto") 'Declara Variavel ultima Linha Dim ultLinha As Long ultLinha = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'Desde a linha 2 até a ultima For i = 2 To ultLinha valor = ws.Cells(i, 1) 'Se "-" existir então If InStr(valor, "-") Then 'Divide valor = Split(valor, "-")(1) 'Remove espaços em branco valor = Trim(valor) 'Define o valor na célula ws.Cells(i, 2) = valor Else ws.Cells(i, 2).Value = valor End If Next i End Sub

Boas @Jeff_Sandes , Experimente assim: "=((@PIArcVal('\\FTHSERVER\ACS_540SE01M1.V';'28/08/2022 0:00:00';0;'';'auto')/0,8333)*0,05617978)" Ps. Não testei

Boas, @Kleber Bispo Tente alterar a seguinte parte do código: consulta2 = "SELECT * FROM Dados WHERE nome =" & "'" & nome_do_loop(i) & "'" Set rs2 = banco.OpenRecordset(consulta2, dbOpenSnapshot) 'Realiza 2ª consulta no Banco de Dados Set wb = xl.Workbooks.Open(nome_arquivo_excel) 'Abre o arquivo excel criado Set ws = ActiveSheet 'Define a planilha ativa ws.Range("A2").CopyFromRecordset rs2 'Copia o Recordset para o arquivo excel wb.Save 'Salva arquivo Excel wb.Close 'Fecha arquivo Excel rs2.Close Set rs2 = Nothing 'Limpa Recordset Set ws = Nothing 'Limpa a variável ws Set wb = Nothing 'Limpa a variável wb Para: Set banco = CurrentDb 'Inicializa a conexão consulta2 = "SELECT * FROM Dados WHERE nome =" & "'" & nome_do_loop(i) & "'" Set rs2 = banco.OpenRecordset(consulta2, dbOpenSnapshot) 'Realiza 2ª consulta no Banco de Dados Set wb = xl.Workbooks.Open(nome_arquivo_excel) 'Abre o arquivo excel criado Set ws = ActiveSheet 'Define a planilha ativa ws.Range("A2").CopyFromRecordset rs2 'Copia o Recordset para o arquivo excel wb.Save 'Salva arquivo Excel wb.Close 'Fecha arquivo Excel rs2.Close Set banco = Nothing 'Fecha conexão Set rs2 = Nothing 'Limpa Recordset Set ws = Nothing 'Limpa a variável ws Set wb = Nothing 'Limpa a variável wb

Boas @artur251209 , Não perde o Save, ele fica gravado na Cloud.

Boas @Swalls , Alternativa Paga Programar em Python e chamar no Excel (VBE) utilizando o pyxll. Por exemplo o seguinte código em Python: from pyxll import xl_macro, xlcAlert @xl_macro def mensagem_popUp(): xlcAlert("Olá, Mundo") Depois no VBE (Visual Basic Editor), chama o código Python através do seguinte código: Sub SubRotinaVBA x = Run("mensagem_popUp") End Sub Alternativa Grátis Utilizando o xlwings junto com o numpy. Código em Python: # olaMundo.py import numpy as np import xlwings as xw def mundo(): wb = xw.Book.caller() wb.sheets[0].range('A1').value = 'Olá, Mundo' Depois no VBE (Visual Basic Editor), chama o código Python através do seguinte código: Sub OlaMundo() RunPython ("import olaMundo; olaMundo.mundo()") End Sub Mas como disse o @Midori

Boas @Jeffersonthedarks , Consegue anexar o ficheiro para podermos ajudar melhor. Obrigado