Лучший способ поиска даты в таблице и, если не найден, вставить дату - PullRequest
0 голосов
/ 06 мая 2020

Я написал следующий код для поиска в столбце A даты документа, который я пытаюсь импортировать, и, если он не найден, вставьте новую строку и импортируйте данные:

' If the document date is earlier than the date in the first line of the spreadsheet search for the date in the A column
ElseIf strSheetDate > strFileNameDate Then
    Set rngSheetDate = WS1.Range("A:A").Find(strFileNameDate)

    ' If the date is found in A column then add the data to that row
    If Not rngSheetDate Is Nothing Then 'when rng <> nothing means found something'

        If WS2.Cells(2, 2).Value <> "" Then WS1.Range(rngSheetDate.Address).Offset(0, 1).Value = WS1.Range(rngSheetDate.Address).Offset(0, 1).Value + WS2.Cells(2, 2).Value
        If WS2.Cells(3, 2).Value <> "" Then WS1.Range(rngSheetDate.Address).Offset(0, 3).Value = WS1.Range(rngSheetDate.Address).Offset(0, 3).Value + WS2.Cells(3, 2).Value


    Else

        ' If it is not found then look for dates either side of the document date and then insert a new line for that record
        iRow2 = WS1.Cells(Rows.count, 1).End(xlUp).Row
        Set rngSheetDate2 = WS1.Range("A2:A" & iRow2)
        For Each cell In rngSheetDate2

            If cell.Value > strFileNameDate And cell.Offset(1, 0).Value < strFileNameDate Then

                WS1.Range(cell.Offset(1, 0), cell.Offset(1, 4)).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                cell.Offset(1, 0).Value = strFileNameDate

                If WS2.Cells(2, 2).Value <> "" Then
                    cell.Offset(1, 1).Value = WS2.Cells(2, 2).Value
                Else
                    cell.Offset(1, 1).Value = 0
                End If

                If WS2.Cells(3, 2).Value <> "" Then
                    cell.Offset(1, 3).Value = WS2.Cells(3, 2).Value
                Else
                    cell.Offset(1, 3).Value = 0
                End If

                Exit For

            End If
        Next

    End If                
End If

Должен быть лучший способ найти строку в столбце 1 таблицы, и если она не найдена, добавьте новую строку в середину таблицы или добавьте в конец.

какой совет?

1 Ответ

1 голос
/ 07 мая 2020

Если все, что вам нужно, это сжатие кода, вы можете удалить много лишнего. Value et c ...

Также If-ElseIf можно перекодировать, но они простые с использованием функции IIf

Обычно установка кода в операторах 'With' также помогает сократить код, а также повысить его эффективность, но здесь нет ничего, что могло бы гарантировать это

Например:

' If the document date is earlier than the date in the first line of the spreadsheet search for the date in the A column
ElseIf strSheetDate > strFileNameDate Then
    Set rngSheetDate = WS1.Range("A:A").Find(strFileNameDate)

    ' If the date is found in A column then add the data to that row
    If Not rngSheetDate Is Nothing Then         'when rng <> nothing means found something
        If WS2.Cells(2, 2) <> "" Then rngSheetDate.Offset(0, 1) = rngSheetDate.Offset(0, 1) + WS2.Cells(2, 2)
        If WS2.Cells(3, 2) <> "" Then rngSheetDate.Offset(0, 3) = rngSheetDate.Offset(0, 3) + WS2.Cells(3, 2)
    Else
        ' If it is not found then look for dates either side of the document date and then insert a new line for that record
        iRow2 = WS1.Cells(Rows.Count, 1).End(xlUp).Row
        Set rngSheetDate2 = WS1.Range("A2:A" & iRow2)
        For Each Cell In rngSheetDate2
            If Cell > strFileNameDate And Cell.Offset(1, 0) < strFileNameDate Then
                WS1.Range(Cell.Offset(1, 0), Cell.Offset(1, 4)).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Cell.Offset(1, 0) = strFileNameDate
                Cell.Offset(1, 1) = IIf(WS2.Cells(2, 2) <> "", WS2.Cells(2, 2), 0)
                Cell.Offset(1, 3) = IIf(WS2.Cells(3, 2) <> "", WS2.Cells(3, 2), 0)
            End If
        Next
    End If
End If
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...