baskar's questions

Preciso exportar dados do MS Access para o MS Excel por consulta de energia

Aqui eu preciso filtrar o ID pelo valor da célula A1

Esta é a consulta

    Source = Access.Database(File.Contents("C:\Users\Bas\Documents\Database2021.mdb"), [CreateNavigationProperties=true]),
    _Hours = Source{[Schema="",Item="Hours"]}[Data],
    #"Filtered Rows" = Table.SelectRows(_Hours, each ([ID] = "6734"))
in
    #"Filtered Rows"

Eu preciso definir deste valor 6734 para CELL A1

É possível, gentilmente me orientar.

Editar1;

    Source = Access.Database(File.Contents("C:\Users\Bas\Documents\Database2021.mdb"), [CreateNavigationProperties=true]),
    _Hours = Source{[Schema="",Item="Hours"]}[Data],
    #"Filtered Rows" = Table.SelectRows(_Hours, each ([ID] = "idfilter"))
in
    #"Filtered Rows"

idFilter = Excel.CurrentWorkbook(){[Name="YourID"]}[Content]

Quando eu insiro a linha sugerida por último, ela receberá um erro. Nomeado A1 como YourID

Eu tenho problema ao filtrar a data de hoje no VBA. Porque o formato mudou para cada usuário. Como defini-lo como formato universal?

Meu código:

'FILTER TODAY DATE IN PIVOT
Private Sub Worksheet_Activate()
  On Error GoTo ErrorHandIer
  
  Dim DateToday As Date
  DateToday = Format(Date, "M/DD/YYYY")
  
  With Me.PivotTables("PivotTable1").PivotFields("CCN_Created_Date")
    .ClearAllFilters
    .CurrentPage = DateToday
  End With
  
  With Me.PivotTables("PivotTable2").PivotFields("Date")
    .CIearAIIFiIters
    .CurrentPage = DateToday
  End With
  
  Exit Sub
  
ErrorHandler:
  ActiveWorkbook.RefreshAII
  MsgBox Err.Number & ": " & Err.Description
End Sub

Eu preciso de uma lista suspensa dependente.

Normalmente categorias e sua lista indexada por =indirect(A1)fórmula

Mas preciso selecionar um valor de lista e depois outro menu suspenso com base na primeira lista suspensa.

Exemplo;

Material. Size
Iron.     22*40
Iron.     31*34
Steel.    21*32 
Aluminum. 56*10
Rubber.   12*12
Rubber.   13*41
Rubber.   10*14

A Lista 1 tem vários materiais.

A lista 2 tem tamanhos.

Se eu selecionar um material, preciso mostrar o tamanho disponível em outro menu suspenso

Eu preciso copiar C74 Cell

Em seguida, cole para C85 para C88

Condition1: Qual célula tem mais de 0 sem necessidade de colar

Condition2: Qual célula tem 0, então cole o valor C74.

*Não há necessidade de colar em todas as células que tenham 0's

*Basta colar o valor na primeira célula que contém 0.

Eu tento para até 2 células. Mas eu preciso para até 4 células.

Alguém me orienta..

Sub TIMECALC()
ActiveSheet.Range("C74").Copy
If ActiveSheet.Range("C85").Value > 0 Then ActiveSheet.Range("C86").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False Else ActiveSheet.Range("C85").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
End Sub

Foto

Eu tenho um problema ao transferir dados do MS Excel para o MS Access pelo SQL Server

aqui está o meu programa

 Public Sub DoTrans()
DoEvents
Sheets("Temp").Select
  Set cn = CreateObject("ADODB.Connection")
  'dbPath = Application.ActiveWorkbook.Path & "\Database2021.mdb"
  dbPath = "\\datasource\Temp\Database2021.mdb"
 dbWb = Application.ActiveWorkbook.FullName
 dbWb = Application.ActiveWorkbook.FullName
  dbWs = Application.ActiveSheet.Name
  scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
  dsh = "[" & Application.ActiveSheet.Name & "$]"
  cn.Open scn

  ssql = "INSERT INTO Table1 ([DataEnteredOn],[Date],[DATA],[EstimatedHours],[ActualHours],[Eff%],[Remarks],[ESR#] ) "
  'ssql = ssql & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh

  ssql = ssql & "SELECT [DataEnteredOn],[Date],[DATA],[EstimatedHours],[ActualHours],[Eff%],[Remarks],[ESR#]  FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh
  cn.Execute ssql
  cn.Close
  
  Sheets("Temp").Select
    
   MsgBox "Your datas saved. If you want to check, Please click ""Complete Database"" button"

Call CLEARDATA

End Sub

A ENTRADA É 0,117

MAS A SAÍDA É 0,110

PRECISO CORRIGIR a conversão de dados.

Consulte o Snap Abaixo, tento ajustar as casas decimais. Mas não é trabalho

Tenho dúvida em comparar duas colunas.

A Coluna B deve ter Dados Exclusivos com o intervalo de Duplicatas da Coluna A (intervalo destacado em cores diferentes).

A coluna A tem dados duplicados> É necessário definir como intervalo para comparar a coluna B (qtd desigual)

Exemplo:

• CONJUNTO 1

19A19 -

19A19 N0025R0

• CONJUNTO 2

A057 021-21----

A057 021-22----

=IF(A2=A:A,IF(COUNTIF(A:A,A2),B2=B3,""),"") Atualmente eu tentei esta fórmula (é apenas comparar a coluna MAT uma por uma)

Preciso de Resultado Correto, pois RED Highlights Alguém me ajude.

Eu preciso copiar e colar valores de Sheet1 Columns(A:B) para Sheet2 Columns(A:B), se Sheet1 Column F="NUMBERS"

Input

A 1 NUMBERS
B 2 TEXT
C 3 NUMBERS
D 4 TEXT
E 5 NUMBERS AND TEXT

OUTPUT
A 1
C 3

Atualmente eu uso o AutoFilter e copio, colo método que às vezes dá erro (porque macro muito longa).

Sheets("sheet1").Select
ActiveWorkbook.save
Range("A1:J1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$J").AutoFilter Field:=6, Criteria1:="Numbers"
 Columns("A:B").Select
    Selection.Copy

 Sheets("Sheet2").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Portanto, preciso encontrar o valor e copiar e colar o método (baseado em loop).

Preciso expandir alguns números de um para outro

Como quando a entrada é 399207 e 10 = Saída 399207 399208 399209 399210

Entrada:

422209           10
904L1009         10
356608           11
0003ML00030-1    3
00EO0632         33
00SH0062         65
0177-5002        3
01RLCB0082901001 3
02AE0078         81
02ID0081         82
0301ME001218-1   3
07HY0569         71
327798           800
336999           7000

Atualmente eu uso a subfunção definida pelo usuário para este processo

Este é o meu código

Function EXPAND_serial(pno As String, n As String, _
                       Optional delim As String = "@")

    Dim m As String, i As Long, pnos As Variant

    m = Right(pno, Len(n))
    pno = Left(pno, Len(pno) - Len(n))
    ReDim pnos((m) To (n))

    For i = (m) To (n)
        pnos(i) = pno & (i)
    Next i


    EXPAND_serial = Join(pnos, delim)

End Function

Quando eu uso este código, ele funciona bem (01 a 09) para números maiores, mas se cruzar 09 a 10 ou mais

Ele pula 0's Portanto, o dígito de entrada não corresponde ao comprimento de cada dígito de saída se 0's vier

Veja meu Snap para melhor entendimento. como resolver isso me ajude

Os destaques de fundo vermelho claro têm problema

Desejo copiar as colunas A e B para o novo intervalo de planilhas A e B (filtro de planilha de origem aplicado na coluna H)

Este código é registrado, quando eu uso este erro aleatório vem. Porque eu tenho 5 submacro e quando eu chamo essas sub macros, elas não são executadas corretamente. Mas Macro individual funciona perfeitamente.

Portanto, preciso copiar sem usar a área de transferência como este método. Não é usado quando a condição de filtro aplicado

Sheets("GROUP1").Range("A:B").Value = Sheets("Sheet3").Range("A:B").Value

macro gravada

Sub Copypaste()
'Application.ScreenUpdating = False

    Sheets("GROUP1").Select

    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1:H1").Select
    Range("H1").Activate
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveSheet.Range("$A:$H").AutoFilter Field:=8, Criteria1:="K-True", Operator:=xlFilterValues
    Columns("A:B").Select
    Application.CutCopyMode = False
    Selection.Copy

       DoEvents
    Sheets("Sheet3").Select
    Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

Entrada:

55958   55959       
55960   55961   55962   55963
60346   60347       
60348   60349

Resultado:

55958-K 55959-K     
55960-K 55961-K 55962-K 55963-K
60346-K 60347-K     
60348-K 60349-K 

Desejo adicionar o sufixo "-K" a todo o intervalo de células.

Primeiro tentei com Custom Number Format { "#-K" }

Isso só funciona com formatos, então pulei (porque preciso com valor).

Então eu tento uma fórmula =IF(A1="","",A1&"-K"), mas aqui eu preciso preencher a fórmula manualmente até a última célula, então eu arrasto manualmente para baixo e para a direita.

Quando eu gravo para Macro, ele tem dados estáticos com células específicas,

Por fim, preciso do Dynamic VBA para fazer esse processo.

Sub Macro2()    'Macro2 Macro
    Sheets("Sheet3").Select
    Range("D2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Sheets("Process").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells.Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Sheets("Process").Select
    Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(Sheet3!R[1]C[3]="""","""",Sheet3!R[1]C[3]&""-K"")"
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    'Selection.AutoFill Destination:=Range("A1:Z1000"), Type:=xlFillDefault
    'Range("A:Z").Select   End Sub