Вставка нового столбца с использованием l oop и ошибка 1004 - PullRequest
0 голосов
/ 14 января 2020

Я пытаюсь вставить столбец на основе даты в ячейку B1. У меня есть различные столбцы с датами в строке 2; однако, мой предоставленный код выдает ошибку 1004, когда я запускаю его. Я полагаю, что это связано с тем, что l oop в конечном итоге попадает в пустую ячейку строки 2, предположительно потому, что дата в ячейке B1 является более новой, чем все другие даты. Как я могу сделать так, чтобы он вставлял столбец справа от последнего столбца с датой в этом случае?

Вот что я имею в виду, предоставленный пользователем "The GridLock":

Sub DateLoopTest()
    Dim i As Integer
    i = 0
    'Loop from [B2] offset 0 to 1,2... -> then stop at [b2].offset(0,i) 
    Do Until (DateValue([b1]) < DateValue(IIf(IsDate([b2].Offset(0, i)), [b2].Offset(0, i), [b1])))
        i = i + 1
    Loop
    [b2].Offset(0, i).EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    [b2].Offset(0, i).Value = [b1]
End Sub

1 Ответ

0 голосов
/ 15 января 2020

Лучше всего использовать переменные, которые что-то значат, и избегать использования скобок для диапазонов. Вы не можете проверить логи c, если не можете определить диапазон. Ваш лог c не проверяет, есть ли дата, превышающая вашу начальную точку, или дата уже существует в диапазоне. Это отправная точка, и вы можете изменить ее, чтобы протестировать другие логи c, но это не даст вам ошибки.

Sub DateLoopTest()
    Dim LC As Long
    Dim MaxDate As Date
    Dim TargetDate As Date
    LC = Cells(2, Columns.Count).End(xlToLeft).Column

    Dim HdrRng As Range
    Set HdrRng = Range(Cells(2, 2), Cells(2, LC))
    MaxDate = WorksheetFunction.Max(HdrRng)

    TargetDate = Cells(1, 2)

    i = 2

    If TargetDate < MaxDate And WorksheetFunction.CountIf(HdrRng, TargetDate) = 0 Then
        Do Until TargetDate > Cells(2, i)
            i = i + 1
        Loop
            Cells(2, i).EntireColumn.Insert Shift:=xlToRight, copyorigin:=xlFormatFromLeftOrAbove
            Cells(2, i).Offset(0, 1) = TargetDate

    ElseIf WorksheetFunction.CountIf(HdrRng, TargetDate) > 0 Then
            Z = HdrRng.Find(TargetDate).Column
            Cells(2, Z + 1).EntireColumn.Insert Shift:=xlToRight, copyorigin:=xlFormatFromLeftOrAbove
            Cells(2, Z + 1) = TargetDate
    End If

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