как получить данные, скопированные на лист, если условие выполнено, и если нет, добавить данные в последнюю строку?VBA - PullRequest
0 голосов
/ 19 февраля 2019

Лист данных (источник данных) содержит данные в следующем формате:

Case ID      Contact     Email           Address
999          Jim         jim@jim.com     (blank)
998          (blank)     (blank)         (blank)

В листе вопросов (пункт назначения) содержится список идентификаторов дел с заполненной проблемой Выпуск 1.Существует список проблем (проблемы 2 и далее) в формате ниже + желаемый результат:

Case ID      Issue 1        Issue 2      Issue 3
999                                      address
998          contact        email        address 

ЦЕЛЬ : поскольку некоторые идентификаторы дел уже присутствуют в проблемах, цель состоит в том, чтобы получитьмакрос для сканирования по листу данных и, если идентификатор дела FOUND ,

  • , проверьте, не заполнено ли поле «Проблема 2».Если это так, получите заголовок столбца и вставьте его в ту же строку, где находится идентификатор случая в выпусках.
  • , если идентификатор случая НЕ НАЙДЕН , затем добавьте идентификатор случая кПоследняя строка «Проблемы», столбец «А», а также добавьте заголовок столбца в столбец «Проблема 2» в той же строке.

Цель состоит в том, чтобы выделить проблемы в Таблице данных с несколькими условиями и вставить их в Проблемы.простынь.В этом случае с помощью приведенного ниже кода оператор IF выполняет поиск ячеек, для которых на листе данных есть Interior.ColorIndex = 2.

ПРОБЛЕМА: мой текущий код перебирает правильно и добавляет код CASE ID, который не найден, кпоследний ряд листа 1. Кроме того, я не уверен, что мои счетчики настроены правильно.Любая помощь будет оценена.

Sub IssuesData()

Dim ws As Worksheet
Dim ws2 As Worksheet
Dim lastrow As Long
Dim lastrow2 As Long
Dim lastrow3 As Long
Dim i As Long
Dim j As Long
Dim wb As Workbook

lastrow = ThisWorkbook.Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
lastrow3 = ThisWorkbook.Sheets("Issues").Cells(Rows.Count, "A").End(xlUp).Row

For j = 2 To lastrow3
    For i = 2 To lastrow
        If ThisWorkbook.Sheets("Data").Cells(i, 10).Interior.ColorIndex = 2 Then
            If Sheets("Data").Cells(i, 3) = Sheets("Issues").Cells(j, 1) Then

            Sheets("Issues").Cells(j, "D") = Sheets("Data").Cells(1, 10)

            End If
        j = j + 1


            Else
                If ThisWorkbook.Sheets("Data").Cells(i, 10).Interior.ColorIndex = 2 Then
                lastrow2 = ThisWorkbook.Sheets("Issues").Cells(Rows.Count, "A").End(xlUp).Row
                Sheets("Data").Cells(i, 3).Copy
                Sheets("Issues").Range("A" & lastrow2 + 1).PasteSpecial xlPasteValues
                Sheets("Data").Cells(1, 10).Copy
                Sheets("Issues").Range("D" & lastrow2 + 1).PasteSpecial xlPasteValues
                End If
            End If

    Next i
Next j

End Sub

1 Ответ

0 голосов
/ 19 февраля 2019

Получилось - надеюсь, это кому-нибудь поможет!

Sub ReadC1LegalContact()

Dim frng As Variant
Dim i As Long
Dim lastrow As Long
Dim pasteRow As Long



    With ThisWorkbook

        lastrow = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row

        For i = 2 To lastrow

            If Sheets("Data").Cells(i, 60).Interior.ColorIndex = 1 Then
                Set frng = Sheets("Issues").Range("A:A").Find(Sheets("Data").Cells(i, 3), , xlValues, xlWhole)

                If Not frng Is Nothing Then
                    If .Sheets("Issues").Cells(frng.Row, "B") = "" Then
                       .Sheets("Issues").Cells(frng.Row, "B") = .Sheets("Data").Cells(1, 60)
                    End If
                Else
                    pasteRow = .Sheets("Issues").Range("A" & Rows.Count).End(xlUp).Row + 1
                    .Sheets("Issues").Range("A" & pasteRow) = .Sheets("Data").Cells(i, 3)
                    .Sheets("Issues").Range("B" & pasteRow) = .Sheets("Data").Cells(1, 60)
                End If
            End If

        Next i

    End With
End Sub
...