OreiaG

Segue uma opção com Formatação Condicional.
 
Em C2 >>> =MÁXIMO(B5:D5)
 
Na Formatação Condicional de C2 aplique 3 regras:
1a. Regra >>> Usar uma fórmula >>> =$C$2=$B$5 >>> formate o preenchimento igual a B5
2a. Regra >>> idem para C5
3a. Regra >>> idem para D5
 
 

=proc(esquerda(f7;1);{"b";"h";"i";"m"};{"américa do sul";"ele";"europa";"ela"})  

Experimente:
=SOMA(DIVIDIRTEXTO(G5;";")*1)  
ou
 
=SOMA(DIVIDIRTEXTO(G5;";")+0)  

Veja se atende.
Sub ConclusivoOuDivergente() Dim r As Range, s As String, b As Boolean For Each r In [A4:J4] If r.Value <= r.Offset(1).Value Then If s <> "" Then s = s & " / " s = s & "célula " & r.Address(0, 0) & " - " & "valor " & r.Value: b = True End If Next r If b Then [M4] = "DIVERGENTE - " & s Else [M4] = "CONCLUSIVO" End Sub  

PriLin = [MAX(IF(NOT(ISERR(LEFT(F10:F45,9)*1)),LEFT(F10:F45,9)*1))]  

Esta fórmula conta diretamente na Planilha1, ou seja, não considera os dados da Planilha2.
=CONT.SE(B2:B22;0)
 
=CONT.SE(Planilha2!B1:B21;"Falta") ou =CONT.SE(Planilha2!B1:B21;">""")  

Veja se esta lhe atende.
 
=ÍNDICE(F2:F71;SOMARPRODUTO((B2:B71<=J5)*(C2:C71>=J5)*(D2:D71<=J6)*(E2:E71>=J6)*(A2:A71=J4)*LIN(F2:F71))-1;0)  

Última tentativa. Segue cópia do seu arquivo, conforme comentei no Post  #15.
 
Reforçando que a execução dos seus dois códigos Worksheet_Calculate, em decorrência da execução do código Sub BTNOK_Click, é desperdício de tempo e de energia: Post #11, segundo período do terceiro parágrafo.
 
 
Teste LEITURA2.rar

Veja se atende.
O código abaixo deve ir no módulo da Planilha1 (clique com o direito na guia da planilha e selecione Exibir Código.
 
Private Sub Worksheet_Change(ByVal Target As Range) Dim nv As String, ov As String If Target.Count > 1 Then Exit Sub If Target.Column > 1 Or Target.Value = "" Then Exit Sub Application.EnableEvents = False nv = Target.Value Application.Undo ov = Target.Value If ov <> "" Then Target.Value = ov & ", " & nv Else: Target.Value = nv Application.EnableEvents = True End Sub  

Usei a sua fórmula que está em AF2 e troquei a coluna de retorno de 6 para 4.
 
Em AG2 e arraste para baixo.
=SE(J2="";"";PROCV(J2;Dados!C:H;4;0))  

@Guto Lima  Veja se esta lhe atende.
 
=OU(E(G11>=C$5;G11<=E$5);E(F11>=C$5;F11<=E$5);E(F11<=C$5;G11>=E$5))  

@deejaywesley  Veja se este lhe atende.
 
Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long If Not Intersect([A1:A17], Target) Is Nothing Then For i = 2 To 17 If Cells(i, "B") <> "" Then Cells(i, "F").Value = Application.WorksheetFunction.VLookup(Cells(i, "B").Value, Sheets("Plan2").[A1:B17], 2, 0) ElseIf Cells(i, "C") <> "" Then Cells(i, "F").Value = Application.WorksheetFunction.VLookup(Cells(i, "C").Value, Sheets("Plan3").[A1:B17], 2, 0) Else: Cells(i, "F").Value = Application.WorksheetFunction.VLookup(Cells(i, "D").Value, Sheets("Plan4").[A1:B17], 2, 0) End If Next i End If End Sub  

@deejaywesley  Veja se este lhe atende.

 
Sub OrdenaDados() Dim k As Long, D As Variant, R As Variant Application.ScreenUpdating = False [D:E] = "" Range("B2:B" & Cells(Rows.Count, 2).End(3).Row).Copy [D2] Columns(4).TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:="-" Range("D2", Cells(Rows.Count, 5).End(3)).Sort Key1:=[E2], Order1:=xlAscending D = Range("D2", Cells(Rows.Count, 5).End(3)) ReDim R(1 To UBound(D), 1 To 1) For k = 1 To UBound(D) R(k, 1) = D(k, 1) & " - " & D(k, 2) Next Range("D2").Resize(UBound(R)) = R Columns(4).AutoFit: [E:E] = "" End Sub  
Considerei os dados a partir de B2; o resultado será colocado a partir de D2.

=substituir(esquerda(c5;núm.caract(c5)-9);" de";"")*1  

Veja se atende.
 
=CONCATENAR(A68;" ";TEXTO(I35;"##,00%");" ";A69;" ";TEXTO(I37;"R$ ##,00");"";A72)  
 
Na UDF, remova a sublinha na linha em que ocorre o erro.
& _ "00" >>> deve ficar assim >>> & "00"

=SOMARPRODUTO(--(DIREITA(TEXTO(A10:A23;"hh:mm");1)="1")) =SOMARPRODUTO(--(DIREITA(MINUTO(A10:A23);1)="1"))  

Experimente esta outra versão. Não testei a parte que anexa um arquivo.
 
Sub Enviar_INFORMATIVO() Dim ws As Worksheet, Anexo As String Application.ScreenUpdating = False Sheets("Planilha2").Range("B1:L11").CopyPicture xlScreen, xlPicture 'PRINT QUE VAI NO E-MAIL PARA COLAR TGL01 _ coloque aqui o nome que está na guia da planilha Sheets.Add ActiveSheet.Paste Destination:=Range("A1") With Selection .ShapeRange.LockAspectRatio = msoTrue .ShapeRange.Width = .ShapeRange.Width * 1.2 'este parâmetro irá aumentar o print da planilha em 20%, _ mas se você quiser reduzir o tamnaho para 80% então coloque 0.8 no lugar de 1.2 End With ActiveWorkbook.EnvelopeVisible = True Set ws = Sheets("Planilha3") 'ONDE PEGA OS E-MAIL PARA ENVIAR CONFIGURAAO EMAIL _ coloque aqui o nome que está na guia da planilha ' Anexo = ThisWorkbook.Path ' NOME DO ARQUIVO PARA ANEXAR ' Anexo = Anexo & "\" & "ORDEM DE CARREGAMENTO.xlsm" ' Anexo = MaisRecentArq(ThisWorkbook.Path & "\") With ActiveSheet.MailEnvelope .Item.To = ws.Range("D10").Value 'Para .Item.CC = ws.Range("D12").Value 'Copia .Item.Subject = ws.Range("D14").Value 'Assunto '.bcc = "[email protected]" '.Attachments.Add Anexo .Item.send End With Application.DisplayAlerts = False ActiveSheet.Delete End Sub  

Os erros ocorrem nas UDFs, visto que nelas os intervalos não referenciam a planilha de interesse, então as UDFs processam os dados da planilha ativa. Coloquei as referências na UDF modificada abaixo.
Function SomaFonteRecebimento() Dim col As Long, r As Range, ws As Worksheet Set ws = Sheets("Março 2023") col = ws.Range("1:1").Find(Day(Date), , xlValues, xlPart).Column For Each r In ws.Range(ws.Cells(2, col), ws.Cells(ws.Cells(2, 1).End(4).Row, col)) If r.Font.Color <> vbBlack And Application.Caller.Offset(, -1).Value = _ ws.Cells(r.Row, 2) And "Recebimentos" = ws.Cells(r.Row, 1) Then SomaFonteRecebimento = SomaFonteRecebimento + r.Value Next r End Function  
Faça igual na outra UDF.
 
Caso as UDFs forem utilizadas em outras planilhas, cujos nomes sejam diferentes de Março 2023, então utilize a instrução abaixo, assim não precisará alterar o nome da planilha nas UDFs.
Set ws = Application.Caller.Parent  

Experimente:
 
=TEXTO(B1;"0\:00")-TEXTO(A1;"0\:00")  
Formate a célula da fórmula  >>>  [h]:mm

Substitua esta linha >>>
WH.Range("B1:L" & Cells(Rows.Count, "L").End(xlUp).Row).Select  
por esta >>>
WH.Range("B1:L11").Select  

Veja se atende.
   
Columns(5).TextToColumns , FieldInfo:=Array(1, 4) 'coluna E Columns(6).TextToColumns , FieldInfo:=Array(1, 4) 'coluna F  

Cole esta UDF em um módulo.
Function separa(c As Range) separa = Trim(Format(c.Value, "@@@@@ @@@@@ @@@@@ @@@@@ @@@@@ @@@@@ @@@@@")) End Function  
Em B1 coloque >>> =separa(A1) e arraste para baixo se houver dados abaixo de A1.

=desloc(peso_exemplo!$b$1;corresp($a3;peso_exemplo!$b:$b;0)-1;corresp(f$2;peso_exemplo!$7:$7;0)-2)  

=cont.núm(a1:a5)*3