Jump to content
Fórum Script Brasil
  • 0

encontrar resultado igual ou posterior a uma data


vania1989

Question

Olá, estou a começar aprender VBA, mas falta me aprender muito e preciso muitop para meu trabalho, estou tentando criar um código que encontre resultado igual ou posterior a uma data mas do mesmo nº processo, identificação do doente.

Na planilha A tenho as colunas, e quero preencher a coluna C e D com as informações da planilha B, checando o numero de processo do doente e verificando a data, tem que ser igual ou superior.

image.png.e4dd8bad714fd37db86a339388506a15.png

Na Planilha B tenho as colunas:

image.png.87e724f466d869e79b8397213c654d63.png

Link do ficheiro:

https://www.transfernow.net/dl/20240128rEj37JIh

criei o código, mas não dá, podem ajudar por favor.

Sub ProcurarDataConsulta()
    Dim wsA As Worksheet
    Dim wsB As Worksheet
    Dim lastRowA As Long, lastRowB As Long
    Dim i As Long, j As Long
    Dim Nºprocessoutente As String
    Dim DataA As Date, DataB As Date


    Set wsA = ThisWorkbook.Sheets("PlanilhaA")
    Set wsB = ThisWorkbook.Sheets("PlanilhaB")

    lastRowA = wsA.Cells(wsA.Rows.Count, "A").End(xlUp).Row
    lastRowB = wsB.Cells(wsB.Rows.Count, "A").End(xlUp).Row


    For i = 2 To lastRowA
        
        Nºprocesso utente = wsA.Cells(i, 1).Value
        Data = wsA.Cells(i, 2).Value

        
        For j = 2 To lastRowB '
            If wsB.Cells(j, 1).Value = doente Then
                DataB = wsB.Cells(j, 2).Value

        
                If DataB >= DataA Then
                    wsA.Cells(i, 3).Value = DataB
                End If
            End If
        Next j
    Next i
End Sub
 

Link to comment
Share on other sites

1 answer to this question

Recommended Posts

  • 0

Olá, segue a solução para o seu problema. qualquer duvida pode mandar DM no insta @thiagoalves.ah, ficarei feliz em ajuda-lo.

Sub GetDados()

    Dim tabDdsMedico    As Range
    Dim tabDdsPaciente  As Range
    Dim iProcesso       As String
    Dim iDate           As Date
    
    Dim i As Long, j As Long
    
    Set tabDdsMedico = Sheet2.Range("A1").CurrentRegion.Offset(1)
    Set tabDdsPaciente = Sheet1.Range("A1").CurrentRegion.Offset(1)

    With tabDdsMedico
        Set tabDdsMedico = .Resize(.Rows.Count - 1)
    End With
    
    With tabDdsPaciente
        Set tabDdsPaciente = .Resize(.Rows.Count - 1)
    End With
    
    On Error GoTo IfError
    
    With tabDdsPaciente
        For i = 1 To .Rows.Count
            iProcesso = CStr(.Cells(i, 1))
            iDate = CDate(.Cells(i, 2))
            
            For j = 1 To tabDdsMedico.Rows.Count
                If iProcesso = CStr(tabDdsMedico.Cells(j, 1)) And _
                    iDate >= CDate(tabDdsMedico.Cells(j, 2)) Then
                    .Cells(i, 3) = tabDdsMedico.Cells(j, 3)
                    .Cells(i, 4) = tabDdsMedico.Cells(j, 4)
                    Exit For
                End If
            Next
        Next
    End With
    MsgBox "Processo concluido com sucesso!", vbInformation, "Concluido"
    Exit Sub

IfError:

    MsgBox "Ocorreu um erro durante o processo de atualização" & _
    vbCrLf & "Reveja a macro de atualização", vbCritical

End Sub

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.



  • Forum Statistics

    • Total Topics
      152.1k
    • Total Posts
      651.9k
×
×
  • Create New...