Проверьте строку условия для копирования и вставки из 1 книги в другую

Question

Пожалуйста, посмотрите на прикрепленное изображение

Это просто фиктивные данные.

Мое требование:

• Если внутренний идентификатор актива (столбец B) является уникальным, независимо от того, выбран ли параметр Копировать строку (столбец F).

• Если внутренний идентификатор актива не уникален, т. Е. Один и тот же внутренний идентификатор актива присутствует в столбце B более одного раза, проверьте, какой внутренний идентификатор актива является столбцом F, помеченным как выбранный, а затем скопируйте только эту строку.

• Скопированные строки: 3-я строка, 5-я строка, 7-я, 8-я, 9-я строка "

Эти данные находятся в Workbook1: Sheet1, и я должен скопировать их в Workbook2:Sheet2 Отображение копирования и вставки должно быть таким, как указано ниже -

WB1:Sheet1 A to WB2:Sheet2 A
WB1:Sheet1 B to WB2:Sheet2 B
WB1:Sheet1 N to WB2:Sheet2 C
WB1:Sheet1 X to WB2:Sheet2 D
WB1:Sheet1 Y to WB2:Sheet2 E
WB1:Sheet1 AY to WB2:Sheet2 G
WB1:Sheet1 C to WB2:Sheet2 H
WB1:Sheet1 D to WB2:Sheet2 I
WB1:Sheet1 E to WB2:Sheet2 J
WB1:Sheet1 F to WB2:Sheet2 K
WB1:Sheet1 BI to WB2:Sheet2 R
WB1:Sheet1 AT to WB2:Sheet2 S
WB1:Sheet1 AU to WB2:Sheet2 T
WB1:Sheet1 AV to WB2:Sheet2 U
WB1:Sheet1 AW to WB2:Sheet2 V

Вставка в Workbook2: Sheet2 должна начинаться с "A12"

Моя попытка:

Sub cpyCol()
    Dim wc As Worksheet, wa As Worksheet
    Dim lr As Long, I As Long, J As Long
    Dim uR As Range
    Dim eNumStorage() As String ' initial storage array to take values
    Dim x As String

    Set wc = Sheets("Test")
    Set wa = Sheets("Test")
    lr = wc.Range("A" & Rows.Count).End(xlUp).Row
    ReDim eNumStorage(1 To lr - 2)

    Application.ScreenUpdating = False
    For I = 3 To lr 'sheets all have headers that are 2 rows
        If (Not IsEmpty(Cells(I, 2).Value)) Then ' checks to make sure the value isn't empty
            J = J + 1
            eNumStorage(J) = Cells(I, 2).Value ' to store values of internal Asset ID in an array
        End If
        If wc.Range("F" & I) = "Selected" Then 'check if column F is marked as selected
            If (uR Is Nothing) Then
                Set uR = Range(I & ":" & I)
            Else
                Set uR = Union(uR, Range(I & ":" & I))
            End If
        End If
    Next I
    uR.copy Destination:=wa.Range("A13")
    Application.ScreenUpdating = True
End Sub

Результат (Для тестирования я только что попытался скопировать и вставить с того же листа на тот же лист) -

• Я могу копировать строки, помеченные как выбранныев столбце F
• Я могу сохранить значения внутреннего идентификатора актива в столбце B в массиве eNumStorage ()
• Так что я могу скопировать 3-ю и 5-ю строку

Где мне нужна помощь -

• Не удается скопировать 7-й, 8-я и 9-я строки.

То, что я пытался скопировать 7-й, 8-й и 9-й ряд

 If eNumStorage(J) = eNumStorage(J + 1) Then
        If wc.Range("F" & I) = "Selected" Then 'check if column F is marked as selected
            If (uR Is Nothing) Then
                Set uR = Range(I & ":" & I)
            Else
                Set uR = Union(uR, Range(I & ":" & I))
            End If
        End If
    End If

Проблема - Не работает для более поздних строк

Любая помощь будет высоко ценится.Благодарю.

Answer 1

Хорошо, я нашел решение, которое делает именно то, что я хотел.Спасибо @PEH за вашу помощь.

Sub cpyCol()
    Dim wc As Worksheet, wa As Worksheet
    Dim lr As Long, I As Long, J As Long, I2 As Long
    Dim uR As Range
    Dim wb, wb1 As Workbook
    Dim eNumStorage() As String ' initial storage array to take values
    Set wb = Workbooks.Open("C:\Users\Z003U8UC\Downloads\PP_Anan.xlsm")
    Set wb1 = ThisWorkbook
    Set ws = wb.Sheets("Procurement plan PM80 ->")
    Set wa = ThisWorkbook.Sheets("Test")
    lRow = ws.Range("A" & Rows.Count).End(xlUp).Offset(-3).Row
    I2 = 11
    Const fRow As Long = 2
    Application.ScreenUpdating = False
    For I = 2 To lRow 'sheets all have headers that are 2 rows
        If Not (Application.WorksheetFunction.CountIf(ws.Range("B" & fRow, "B" & lRow), ws.Range("B" & I)) > 1 And _
        Application.WorksheetFunction.CountIfs(ws.Range("B" & fRow, "B" & lRow), ws.Range("B" & I), ws.Range("AY" & fRow, "AY" & lRow), "Selected") = 1 _
        And ws.Range("AY" & I) <> "Selected") Then
'            If (uR Is Nothing) Then
'                Set uR = Range(I & ":" & I)
'            Else
'                Set uR = Union(uR, Range(I & ":" & I))
'            End If
            I2 = I2 + 1
            wa.Cells(I2, "A") = ws.Cells(I, "A")
            wa.Cells(I2, "B") = ws.Cells(I, "B")
            wa.Cells(I2, "C") = ws.Cells(I, "N")
            wa.Cells(I2, "D") = ws.Cells(I, "X")
            wa.Cells(I2, "E") = ws.Cells(I, "Y")
            wa.Cells(I2, "G") = ws.Cells(I, "AY")
            wa.Cells(I2, "H") = ws.Cells(I, "C")
            wa.Cells(I2, "I") = ws.Cells(I, "D")
            wa.Cells(I2, "J") = ws.Cells(I, "E")
            wa.Cells(I2, "K") = ws.Cells(I, "F")
            wa.Cells(I2, "R") = ws.Cells(I, "BI")
            wa.Cells(I2, "S") = ws.Cells(I, "AT")
            wa.Cells(I2, "T") = ws.Cells(I, "AU")
            wa.Cells(I2, "U") = ws.Cells(I, "AV")
            wa.Cells(I2, "V") = ws.Cells(I, "AW")
        End If
    Next I
    'uR.copy Destination:=ws.Range("A13")
    wb.Save
    wb.Close
    Application.ScreenUpdating = True
End Sub

Если это может быть улучшено, пожалуйста, дайте мне знать.

Answer 2

Чтобы определить, какая строка должна быть скопирована, а какая нет, вы можете использовать эту формулу в столбце G

=IF(AND(COUNTIF(B:B,B:B)>1,COUNTIFS(B:B,B:B,F:F,"Selected")=1,F:F<>"Selected"),"-","copy")

Теперь вы можете даже использовать фильтры для фильтрации по столбцу G.

Пояснение

• COUNTIF(B:B,B:B) подсчитывает вхождения "AssetID".Так что это тест на уникальность, если это >1, идентификатор не уникален.

• COUNTIFS(B:B,B:B,F:F,"Selected") подсчитывает вхождения неуникальных «AssedID», которые «выбраны».Таким образом, если это =1, это означает, что один из идентификаторов был помечен как выбранный.

• F:F<>"Selected" означает, что идентификатор не был выбран

В целом формула означает: пометить все идентификаторы как Copy, но отсортировать их, которые…

• не уникальны
• И не уникальны и не выбраны
• И не выбрано

, и это в основном означает, что все помеченные как копии будут:

• уникальные
• ИЛИ неуникальные и выбранные
• ИЛИ выбрано

---

Или пример с VBA
с использованием почти такой же формулы.

Sub Example()
    Dim ws As Worksheet
    Set ws = Worksheets("Tabelle3") 'your worksheet

    Dim lRow As Long 'last used row
    lRow = ws.Cells(ws.Cells.Rows.Count, "A").End(xlUp).Row

    Const fRow As Long = 3 'first row with data


    Dim i As Long
    For i = fRow To lRow 'run from first data row to last
        If Not (Application.WorksheetFunction.CountIf(ws.Range("B" & fRow, "B" & lRow), ws.Range("B" & i)) > 1 And _
           Application.WorksheetFunction.CountIfs(ws.Range("B" & fRow, "B" & lRow), ws.Range("B" & i), ws.Range("F" & fRow, "F" & lRow), "Selected") = 1 And _
           ws.Range("F" & i) <> "Selected") Then

            'copy this line

        End If
    Next i
End Sub