Конкретные данные из рабочей таблицы не копируются правильно на другую - ошибка выполнения 1004 - PullRequest
0 голосов
/ 10 октября 2019

У меня есть рабочий лист «Данные», в котором хранятся данные. Он содержит 20 столбцов AU, а в столбце G указана дата, обозначающая дд / мм / гггг. У меня есть отдельная рабочая таблица под названием «NoEntry», и здесь я бы хотел, чтобы даты вводились пользователем (начальная дата L15 и конечная дата в L16), и после того, как кнопка нажала все данные между, включая начало идата окончания войдет в другую рабочую таблицу с именем «DateData».

Приведенный ниже код совсем не работает, и я не знаю почему. Я получаю сообщение об ошибке: Ошибка времени выполнения 1004:

Debug Error

Line of code Error

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False

Dim wsData As Worksheet, wsDate As Worksheet, wsNoEntry As Worksheet
Dim dSDate As Date, dEDate As Date
Dim lRowStart As Long, lRowEnd As Long
Dim aData() As Variant
Dim i As Long


'set the worksheet objects
Set wsData = ThisWorkbook.Sheets("Data")
Set wsDate = ThisWorkbook.Sheets("DateData")
Set wsNoEntry = ThisWorkbook.Sheets("NoEntry")

'required variables
dSDate = wsNoEntry.Range("L15").Value
dEDate = wsNoEntry.Range("L16").Value

'set the array - you can make this dynamic!
aData = wsData.Range("A1:U1000").Value

'for loop to find start
For i = 1 To 1000
    If aData(i, 7) = dSDate Then
        lRowStart = i
        Debug.Print "Start row = " & lRowStart
        Exit For
    End If
Next i

'now loop backwards to find end date
For i = 1000 To 1 Step -1
    If aData(i, 7) = dEDate Then
        lRowEnd = i
        Exit For
    End If
Next i

'now we have start and end dates
'going to use copy/ paste for simplicity
wsData.Range("A" & lRowStart, "U" & lRowEnd).Copy
'paste in date sheet
wsDate.Range("A1").PasteSpecial Paste:=xlPasteValues
'clear clipboard
Application.CutCopyMode = False

Application.ScreenUpdating = True
End Sub

NoEntry Worksheet

Data worksheet

Любая помощь будет высоко ценится, спасибо:)

1 Ответ

1 голос
/ 10 октября 2019

Попробуйте это:

Private Sub CommandButton2_Click()
Dim wsData As Worksheet, wsDate As Worksheet, wsNoEntry As Worksheet
Dim dSDate As Date, dEDate As Date
Dim lRowStart As Long, lRowEnd As Long
Dim aData() As Variant
Dim i As Long

Application.ScreenUpdating = False    

Set wsData = ThisWorkbook.Sheets("Data")
Set wsDate = ThisWorkbook.Sheets("DateData")
Set wsNoEntry = ThisWorkbook.Sheets("NoEntry")


dSDate = wsNoEntry.Range("L15").Value
dEDate = wsNoEntry.Range("L16").Value
j = 1

For i = 1 To 1000
    If wsData.Cells(i, 7).Value >= dSDate and wsData.Cells(i, 7).Value <= dEDate Then
        Range("A" & i & ":U" & i).Copy Destination:=wsDate.Range("A" & j)
        j = j + 1
    End If
Next i
Application.ScreenUpdating = True

End Sub

Надеюсь, это поможет

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...