Удалите ячейки с #NA, используя оператор if в коде VBA - PullRequest
0 голосов
/ 25 апреля 2019

Я хочу удалить #NA в этом коде, я знаю, что вы предполагаете выражение if, но я не знаю, где и как я должен написать его в своем коде

Sub Copy_Paste_Below_Last_Cell()
'Find the last used row in both sheets and copy and paste data below existing data.

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim CopyColumns() As Variant
CopyColumns = Array("B", "E", "H", "K", "N")
Dim Col As Variant


  Set wsCopy = ThisWorkbook.Worksheets("Ba pricing")
  Set wsDest = ThisWorkbook.Worksheets("Loader")

        For Each Col In CopyColumns

          lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "C").End(xlUp).Offset(1).Row

          lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, Col).End(xlUp).Row

          wsCopy.Range(Col & "30:" & Col & lCopyLastRow).Copy
          wsDest.Range("C" & lDestLastRow).PasteSpecial xlPasteValues



         Next Col


End Sub

Ответы [ 2 ]

0 голосов
/ 25 апреля 2019

Если вы собираетесь удалить ошибки # N / A после копирования значений из формул в наборе столбцов, почему бы просто не пропустить копирование ошибок # N / A для начала?

Sub valueOnlyCopy()

    Dim a As Long
    Dim copyColumns As Variant, col As Variant
    Dim valRng As Range, wsCopy As Worksheet, wsDest As Worksheet

    copyColumns = Array("B", "E", "H", "K", "N")
    Set wsCopy = ThisWorkbook.Worksheets("Ba pricing")
    Set wsDest = ThisWorkbook.Worksheets("Loader")

    For Each col In copyColumns

        With wsCopy
            With .Range(.Cells(30, col), .Cells(.Rows.Count, col).End(xlUp))
                Set valRng = .SpecialCells(xlCellTypeFormulas, xlNumbers + xlTextValues + xlLogical)
            End With
        End With

        With wsDest
            For a = 1 To valRng.Areas.Count
                .Cells(.Rows.Count, "C").End(xlUp).Offset(1).Resize(valRng.Areas(a).Rows.Count, 1) = _
                  valRng.Areas(a).Value
            Next a
        End With

    Next col

End Sub
0 голосов
/ 25 апреля 2019

Хотя я не мог четко понять это требование, я предположил, что #NA следует удалять только из пункта назначения. Я бы предпочел сделать удаление только после завершения задачи копирования и вставки.

Sub Copy_Paste_Below_Last_Cell()
'Find the last used row in both sheets and copy and paste data below existing data.

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim CopyColumns() As Variant
CopyColumns = Array("B", "E", "H", "K", "N")
Dim Col As Variant

Dim FinalStartRow As Long
Dim FinalEndRow As Long
Dim Cel As Range

Set wsCopy = ThisWorkbook.Worksheets("Ba pricing")
Set wsDest = ThisWorkbook.Worksheets("Loader")

FinalStartRow = wsDest.Cells(wsDest.Rows.Count, "C").End(xlUp).Offset(1).Row
FinalEndRow = 0

        For Each Col In CopyColumns
          lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "C").End(xlUp).Offset(1).Row
          lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, Col).End(xlUp).Row
          wsCopy.Range(Col & "30:" & Col & lCopyLastRow).Copy
          wsDest.Range("C" & lDestLastRow).PasteSpecial xlPasteValues
          FinalEndRow = FinalEndRow + lCopyLastRow - 30 + 1
         Next Col


    For Each Cel In wsDest.Range("C" & FinalStartRow & ":C" & FinalEndRow).Cells
        If Application.WorksheetFunction.IsNA(Cel) Then
        Cel.Delete xlShiftUp   ' if required to delete cell
        'Cel.ClearContents     ' if required to delete contents only
        End If
    Next
End Sub

Редактировать: если вы хотите пропустить копирование всего столбца, если он содержит # Н / Д, то просто измените свой код следующим образом

For Each Col In CopyColumns
  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "C").End(xlUp).Offset(1).Row
  lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, Col).End(xlUp).Row
    If wsCopy.Range(Col & "30:" & Col & lCopyLastRow).Find("#N/A", LookIn:=xlValues) Is Nothing Then
    wsCopy.Range(Col & "30:" & Col & lCopyLastRow).Copy
    wsDest.Range("C" & lDestLastRow).PasteSpecial xlPasteValues
    End If
 Next Col

Edit2: добавлен для копирования 2-го набора столбцов в столбец H

Dim CopyRng As Range, CopyRng2 As Range

        For Each Col In CopyColumns
          lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "C").End(xlUp).Offset(1).Row
          lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, Col).End(xlUp).Row
          Set CopyRng = wsCopy.Range(Col & "30:" & Col & lCopyLastRow)
          'Since the 2nd set of columns specified is just at the right of columns specified in the 1st set
          Set CopyRng2 = wsCopy.Range(CopyRng(1, 1).Offset(0, 1), CopyRng(CopyRng.Rows.Count, 1).Offset(0, 1))

            If CopyRng.Find("#N/A", LookIn:=xlValues) Is Nothing Then
            CopyRng.Copy
            wsDest.Range("C" & lDestLastRow).PasteSpecial xlPasteValues
            CopyRng2.Copy
            wsDest.Range("H" & lDestLastRow).PasteSpecial xlPasteValues
            End If
         Next Col
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...