2014-02-26 2 views
0

У меня есть сценарий здесь, где у меня есть три вкладки под названием Лист1, Лист2, Лист3 и Столбец Н каждого листа содержат дату.Excel Необходима визуальная базовая помощь

Что я хочу программу VBA, где в пользователь определяет поле ввода даты начала и окончания использования и программа должен цикл в графе H, чтобы найти, если дата клеток падает между указан диапазон дат пользователем в поле ввода. Если программа может найти дату, которая находится между диапазоном, указанным пользователем , затем скопируйте эту строку и вставьте ее на новую вкладку «FINAL» так же, как она должна перейти на лист 2 и выполнить ту же самую действие и скопируйте строку и вставьте вкладку «ОКОНЧАТЕЛЬНЫЙ».

Так что, если вы видите, требуется два перекручивания ОНКА в колонке H и затем в Таблицах

я написал некоторые вещи, как это, но с трудом, чтобы получить это сделана, любую помощь на этом направлении будет очень ценится.

Sub CopyData() 
    Application.ScreenUpdating = False 
    Dim inputboxa As Date 
    Dim inputboxb As Date 
    Dim ws As Worksheet 
    Dim cell As Range 

    inputboxa = startdate 
    inputboxb = enddate 

    startdate = InputBox("Enter Start Date" & vbCrLf & vbCrLf & "dd/mm/yyyy Format", "Lease", "01/02/2014", 500, 700) 
    enddate = InputBox("Enter enddate Date" & vbCrLf & vbCrLf & "dd/mm/yyyy Format", "Lease", "28/02/2014", 500, 700) 

    For Each ws In Worksheets 

     If ws.Visible = True And ws.Name <> "303010 V094" Then 
      Sheets(ws.Name).Select 

      For Each cell In Range("H1:H1000").Cells 
       ''Range("h1:h1000").Select 
       ''Do Until Range("h1:h1000").Value = vbNullString 
       If Range(cell).Value >= startdate And Range("h1").Value <= enddate Then 
        Range(cell).EntireRow.Copy Sheets("test").Cells(Rows.Count, "A").End(xlUp).Offset(2, 0) 
       End If 
      Next cell 

      Application.ScreenUpdating = True 
      ''End If 
     End If 
    Next ws 
End Sub 

ответ

1

вы хотите использовать DATEDIFF сравнивать значение даты:

Sub CopyData() 
Application.ScreenUpdating = False 
Dim inputboxa As Date 
Dim inputboxb As Date 
Dim ws As Worksheet 
Dim cell As Range 


inputboxa = startdate 
inputboxb = enddate 


startdate = InputBox("Enter Start Date" & vbCrLf & vbCrLf & "dd/mm/yyyy Format", "Lease", "01/02/2014", 500, 700) 
enddate = InputBox("Enter enddate Date" & vbCrLf & vbCrLf & "dd/mm/yyyy Format", "Lease", "28/02/2014", 500, 700) 


For Each ws In Worksheets 


If ws.Visible = True And ws.Name <> "303010 V094" Then 
Sheets(ws.Name).Select 

For Each cell In Range("H1:H1000").Cells 

''Range("h1:h1000").Select 
''Do Until Range("h1:h1000").Value = vbNullString 

If DateDiff("d", cell.Value, startdate) <= 0 And DateDiff("d", cell.Value, enddate) > 0 Then 
cell.EntireRow.Copy Sheets("test").Cells(Rows.Count, 1).End(xlUp).Offset(2, 0) 
End If 
Next cell 


Application.ScreenUpdating = True 
''End If 
End If 
Next ws 
End Sub 

Пользователь Cell вместо Range (Cell). Также убедитесь, что ваш формат даты на самом деле «dd/mm/yyyy», или сравнение не удастся, прочитав неверное значение, и столбец A листов («test») не пуст (или вы будете переписываться в одну и ту же ячейку снова и снова)

1

С кодом возникает ряд проблем.

  1. Range(cell) является излишним; просто используйте cell
  2. Вы не объявляете startdate/enddate. И вы объявляете inputboxa/inputboxb, но не используете их.
  3. Вы читаете startdate/enddate как строку, но затем сравниваете его со значениями в столбце H, которые больше всего похожи в формате даты. Перед сопоставлением вам нужно преобразовать startdate/enddate в значение Date.
  4. .Cells в Range("H1:H1000").Cells не требуется.
  5. Не знаете, почему вы закрываете ScreenUpdating, затем снова включаете его после обработки каждого листа. Вероятно, вы захотите сделать это один раз в конце.

Пробуйте использовать следующий код. Обратите внимание, что это предполагает, что ваш локальный формат даты равен dd/mm/yyyy.

Option Explicit 
Sub CopyData() 
    Application.ScreenUpdating = False 
    Dim startDate As Date 
    Dim endDate As Date 
    Dim ws As Worksheet 
    Dim cell As Range 

    startDate = DateValue(InputBox("Enter Start Date" & vbCrLf & vbCrLf & "dd/mm/yyyy Format", "Lease", "01/02/2014", 500, 700)) 
    endDate = DateValue(InputBox("Enter enddate Date" & vbCrLf & vbCrLf & "dd/mm/yyyy Format", "Lease", "28/02/2014", 500, 700)) 

    For Each ws In Worksheets 
     If ws.Visible = True And ws.Name <> "303010 V094" And ws.Name <> "test" Then 
      Sheets(ws.Name).Select 

      For Each cell In Range("H1:H1000") 
       If cell.Value >= startDate And cell.Value <= endDate Then 
        cell.EntireRow.Copy Sheets("test").Cells(Rows.Count, "A").End(xlUp).Offset(2, 0) 
       End If 
      Next cell 

     End If 
    Next ws 
    Application.ScreenUpdating = True 
End Sub 
+1

Худший нарушитель - это то, что лист _test_ должен быть скрыт или иначе будет хаос. Поэтому лучше явно не перебирать ваш целевой лист. –

+0

@amadeus Очень верно; Я предположил, что это так, но было бы безопаснее исключить его конкретно. Я обновляю свой ответ, чтобы включить проверку на это. – Joe

Смежные вопросы