Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Pesquisa entre data...
 
Notifications
Clear all

Pesquisa entre datas

 
2024 - VBA & Macros
Post Recente por Wagner Morel 7 anos atrás
4 Posts
2 Usuários
0 Reactions
1,002 Visualizações
RSS
 Andersonrj
(@andersonrj)
Posts: 11
Active Member
Topic starter
 

Olá estou tentando fazer uma pesquisa por período, onde ao inserir o período eu consiga classificar as datas do menor para o maior e depois que encontrar o período prescrito selecionar uma linha da planilha e colar em outra, mas não estou conseguindo segue o meu código, ficarei grato se puderem me ajudar:

Sheets("Plan3").Select
Range("A1").Select
    Range("B8:AH2461").Select
    ActiveWorkbook.Worksheets("Plan3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Plan3").Sort.SortFields.Add Key:=Range("F8:F1513") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Plan3").Sort
        .SetRange Range("B8:AH1513")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    
Dim datainicio, datafinal As Date
Dim linha As Integer

datainicio = txtboxdatainicio
datafinal = txtboxdatafinal
linha = 8
Sheets("Plan3").Select
Do Until Sheets("Plan3").Cells(linha, 6) <= datafinal
'seleciona célula com o código
If Sheets("Plan3").Cells(linha, 6) >= datainicio And Sheets("Plan3").Cells(linha, 6) <= datafinal Then
Intersect(Selection.EntireRow, Range("A:AH")).Select
    Selection.Copy
Sheets("Plan6").Select
Range("A8").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False


ListBox1.ColumnCount = 34
ListBox1.RowSource = "B:AH"

End If

linha = linha + 1

Loop




Sheets("Plan5").Select
 
Postado : 26/08/2017 11:12 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

Andersonrj,

Boa tarde!

Assim, sem ver o arquivo, rodar e depurar, fica meio difícil fazer suposições...

A priori vi alguns equívocos em seu código e arrumei mas não sei se funciona. Tente assim:

Sheets("Plan3").Select
Range("A1").Select
    Range("B8:AH2461").Select
    ActiveWorkbook.Worksheets("Plan3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Plan3").Sort.SortFields.Add Key:=Range("F8:F1513") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Plan3").Sort
        .SetRange Range("B8:AH1513")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
   
Dim datainicio As Date, datafinal As Date
Dim linha As Integer

datainicio = CDate(txtboxdatainicio.Text)
datafinal = CDate(txtboxdatafinal.Text)
linha = 8
Sheets("Plan3").Select
Do Until CDate(Sheets("Plan3").Cells(linha, 6).Value) <= datafinal
'seleciona célula com o código
IfCDate(Sheets("Plan3").Cells(linha, 6).Value) >= datainicio And CDate(Sheets("Plan3").Cells(linha, 6).Value) <= datafinal Then
Intersect(Selection.EntireRow, Range("A:AH")).Select
    Selection.Copy
Sheets("Plan6").Select
Range("A8").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False


ListBox1.ColumnCount = 34
ListBox1.RowSource = "B:AH"

End If

linha = linha + 1

Loop




Sheets("Plan5").Select

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 26/08/2017 1:27 pm
 Andersonrj
(@andersonrj)
Posts: 11
Active Member
Topic starter
 

Obrigado amigo com isso conseguir achar o erro.

 
Postado : 30/08/2017 5:30 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

De nada!

Por favor, vote positivamente clicando na mãozinha existente ao lado da ferramenta CITAR.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 30/08/2017 6:04 am
Forum Jump:
  Tópico Anterior
Próximo Tópico