Несколько операторов IF в коде VBA для извлечения различных значений ячеек из нескольких столбцов на основе другого столбца. - PullRequest
0 голосов
/ 20 ноября 2018

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

Объяснение:

У меня есть несколько записей # в Sheet1. Мне нужно найти совпадение для того же самого в Sheet2, и когда оно будет найдено, мне нужно, чтобы оно возвращало значения, которые находятся в столбцах 8 и 15, на основе на значении (и впоследствии строке #) в столбце 7 .

Например:

   Sheet1:
        Column 1 
        123
        999
        989

Sheet2:
Column1   Column7   Column8      Column 15
321        PRA      PRAABC       Completed
123        IRA      IRABCD       Cancelled
000        TPSD     TPSDRST      Completed
989        APSD     APSDABC      In Prog

Таким образом, результаты будут:

123 IRABCD отменен

989 APSDABC In Prog

Мой код ниже:

Sub CopyBasedonSheet1()

Dim i As Long
Dim j As Long
Sheet1LastRow = Worksheets("Sheet1").Range("O" & Rows.Count).End(xlUp).Row
Sheet2LastRow = Worksheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row

    For j = 1 To Sheet1LastRow
        For i = 1 To Sheet2LastRow
            If Worksheets("Sheet1").Cells(j, 15).Value = Worksheets("Sheet2").Cells(i, 2).Value Then 'if Engagement # from sheet1 matches sheet2

                    If Worksheets("Sheet2").Cells(i, 7) = "IRA" Then
                        Worksheets("Sheet1").Cells(j, 23).Value = Worksheets("Sheet2").Cells(i, 8).Value 
                        Worksheets("Sheet1").Cells(j, 24).Value = Worksheets("Sheet2").Cells(i, 15).Value
                    If Worksheets("Sheet2").Cells(i, 7) = "TPSD" Then
                        Worksheets("Sheet1").Cells(j, 25).Value = Worksheets("Sheet2").Cells(i, 8).Value
                        Worksheets("Sheet1").Cells(j, 26).Value = Worksheets("Sheet2").Cells(i, 15).Value
                    ElseIf Worksheets("Sheet2").Cells(i, 7) = "CA" Then
                        Worksheets("Sheet1").Cells(j, 27).Value = Worksheets("Sheet2").Cells(i, 8).Value
                        Worksheets("Sheet1").Cells(j, 28).Value = Worksheets("Sheet2").Cells(i, 15).Value

            Else
            End If
    Next i
Next j
End Sub

Я получаю "Next without For" ошибку при Next i

Ответы [ 3 ]

0 голосов
/ 20 ноября 2018

В коде отсутствуют два End If. Чтобы избежать этой проблемы, добавьте End If s на ходу и заполните содержимое блока If после.

If Worksheets("Sheet1").Cells(j, 15).Value = Worksheets("Sheet2").Cells(i, 2).Value Then

End If

Использование средства форматирования кода для автоматического отступа вашего кода поможет отловить такие ошибки. Проверьте RubberDuck .

Sub CopyBasedonSheet1()

    Dim i As Long
    Dim j As Long
    Sheet1LastRow = Worksheets("Sheet1").Range("O" & Rows.Count).End(xlUp).row
    Sheet2LastRow = Worksheets("Sheet2").Range("B" & Rows.Count).End(xlUp).row

    For j = 1 To Sheet1LastRow
        For i = 1 To Sheet2LastRow
            If Worksheets("Sheet1").Cells(j, 15).Value = Worksheets("Sheet2").Cells(i, 2).Value Then    'if Engagement # from sheet1 matches sheet2
                If Worksheets("Sheet2").Cells(i, 7) = "IRA" Then
                    Worksheets("Sheet1").Cells(j, 23).Value = Worksheets("Sheet2").Cells(i, 8).Value
                    Worksheets("Sheet1").Cells(j, 24).Value = Worksheets("Sheet2").Cells(i, 15).Value
                    If Worksheets("Sheet2").Cells(i, 7) = "TPSD" Then
                        Worksheets("Sheet1").Cells(j, 25).Value = Worksheets("Sheet2").Cells(i, 8).Value
                        Worksheets("Sheet1").Cells(j, 26).Value = Worksheets("Sheet2").Cells(i, 15).Value
                    ElseIf Worksheets("Sheet2").Cells(i, 7) = "CA" Then
                        Worksheets("Sheet1").Cells(j, 27).Value = Worksheets("Sheet2").Cells(i, 8).Value
                        Worksheets("Sheet1").Cells(j, 28).Value = Worksheets("Sheet2").Cells(i, 15).Value

                    Else

                    End If
                End If
            End If
        Next i
    Next j
End Sub

Использование Scripting.Dictionary для сопоставления уникальных значений значительно быстрее, чем использование вложенных циклов. Смотреть: Введение в Excel VBA, часть 39 - Словари .

Sub RefactoredCopyBasedonSheet1()
    Dim dic As Object, key As Variant, row As Range
    Dim r As Long

    Set dic = CreateObject("Scripting.Dictionary")

    With Worksheets("Sheet2")
        For r = 1 To .Range("B" & Rows.Count).End(xlUp).row
            key = .Cells(r, "B").Value
            Set dic(key) = .Rows(r)
        Next
    End With

    With Worksheets("Sheet1")
        For r = 1 To .Range("O" & Rows.Count).End(xlUp).row
            key = .Cells(r, "O").Value
            If dic.Exists(key) Then
                Set row = dic(key)
                Select Case row.Cells(1, 7)
                    Case "IRA"
                        .Cells(j, 23).Value = row.Cells(1, 8).Value
                        .Cells(j, 24).Value = row.Cells(1, 15).Value
                    Case "TPSD"
                        .Cells(j, 25).Value = row.Cells(1, 8).Value
                        .Cells(j, 26).Value = row.Cells(1, 15).Value
                    Case "CA"
                        .Cells(j, 27).Value = row.Cells(1, 8).Value
                        .Cells(j, 28).Value = row.Cells(1, 15).Value
                End Select
            End If
        Next
    End With
End Sub
0 голосов
/ 20 ноября 2018

в жестком коде

в жестком коде?Это означает, что используются кодовые имена листов, поэтому вы просто пишете, например, Sheet1.Name, Sheet2.Rows.Count и т. Д. Вы можете найти кодовое имя в VBE (F11).Когда вы щелкаете лист, в первой строке окна свойств отображается свойство (name) , где вы также можете изменить его.Но интересная часть заключается в том, что вы можете переименовать свои листы через вкладку листа, и код все равно будет работать.

Вы должны всегда использовать Option Explicit перед любым кодом в модуле, потому что онукажет, есть ли ошибка в коде.

Используйте константы в начале процедуры (Sub или Function) для чисел и строк, так что вы будетелегко найти их, и если вы хотите изменить их, вам нужно будет сделать это только один раз .Представьте, что вы больше не будете получать данные из столбца 15, а только данные из столбца 12. Вам придется многократно изменять их в своем коде, но с помощью констант вы меняете его только один раз .

Поскольку я не знаю, что находится в столбцах, я использовал общие имена переменных, но вы всегда должны использовать более описательных таких, как intSource, lngData, objWbSource,objWsTarget, rngValues, intCount и т. д.

Используйте оператор With ... End With , особенно для рабочих листов, не только для того, чтобы не вводить их имя много раз, но чтобы сделать код более для чтения для других или для себя, например, через месяцы или годы.

В этом коде использовался другой способ (с использованием метода поиска) определения последней использованной строки ,единственное отличие заключается в предпочтительном способе, например .Cells (Rows.Count, 1) .End (xlUp) .Row, что он не будет пропускать последнюю строку, если у вас есть данные.

Option Explicit

Sub CopyBasedonSheet1()

  ' Columns in Sheet1
  Const cInt1_1 As Integer = 15   ' O
  Const cInt1_2 As Integer = 23   ' W
  Const cInt1_3 As Integer = 24   ' X
  Const cInt1_4 As Integer = 25   ' Y
  Const cInt1_5 As Integer = 26   ' Z
  Const cInt1_6 As Integer = 27   ' AA
  Const cInt1_7 As Integer = 28   ' AB
  ' Columns in Sheet2
  Const cInt2_1 As Integer = 2    ' B
  Const cInt2_2 As Integer = 7    ' G
  Const cInt2_3 As Integer = 8    ' H
  Const cInt2_4 As Integer = 15   ' O

  Const cStrSearch1 As String = "IRA"
  Const cStrSearch2 As String = "TPSD"
  Const cStrSearch3 As String = "CA"

  Dim lngLR1 As Long  ' Sheet1 Last Used Row
  Dim lngLR2 As Long  ' Sheet2 Last Used Row
  Dim lng1 As Long    ' Sheet1 Row Counter
  Dim lng2 As Long    ' Sheet2 Row Counter

  ' Sheet2
  With Sheet2
    ' Last Row Sheet2
    lngLR2 = .Range(.Cells(1, cInt2_1), .Cells(Rows.Count, cInt2_1)) _
        .Find(What:="*", After:=.Cells(1, cInt2_1), _
        LookIn:=xlFormulas, Lookat:=xlWhole, _
        SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row
  End With

  ' Sheet1
  With Sheet1

    ' Last Row Sheet1
    lngLR1 = .Range(.Cells(1, cInt1_1), .Cells(Rows.Count, cInt1_1)) _
        .Find(What:="*", After:=.Cells(1, cInt1_1), _
        LookIn:=xlFormulas, Lookat:=xlWhole, _
        SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row

    For lng1 = 1 To lngLR1
      For lng2 = 1 To lngLR2
          ' Check if Engagement # from Sheet1 matches Sheet2
          If .Cells(lng1, cInt1_1).Value = Sheet2.Cells(lng2, cInt2_1).Value _
            Then
            Select Case Sheet2.Cells(lng2, cInt2_2).Value
              Case cStrSearch1
                .Cells(lng1, cInt1_2).Value = Sheet2.Cells(lng2, cInt2_3).Value
                .Cells(lng1, cInt1_3).Value = Sheet2.Cells(lng2, cInt2_4).Value
              Case cStrSearch2
                .Cells(lng1, cInt1_4).Value = Sheet2.Cells(lng2, cInt2_3).Value
                .Cells(lng1, cInt1_5).Value = Sheet2.Cells(lng2, cInt2_4).Value
              Case cStrSearch3
                .Cells(lng1, cInt1_6).Value = Sheet2.Cells(lng2, cInt2_3).Value
                .Cells(lng1, cInt1_7).Value = Sheet2.Cells(lng2, cInt2_4).Value
              Case Else
            End Select
           Else
          End If
      Next
    Next

  End With

End Sub
0 голосов
/ 20 ноября 2018

Вот так может выглядеть упрощенная версия вашего кода.Обратите внимание на следующие изменения:

  1. Объявление переменных таблицы (ws1 & ws2) для уменьшения количества попыток ввода / чтения строки Worksheets("Sheet#")
  2. Переключено сElseIf метод использования Select Case
  3. Исправлены некоторые неквалифицированные объекты в расчете последней строки
  4. Добавлено Option Explicit для ясности

Когда дело доходит до эффективностивам, вероятно, будет лучше перебрать массив, а не такой диапазон.В любом случае, неплохо бы переключить Screen Updating, чтобы ускорить процесс.


Option Explicit

Sub CopyBasedonSheet1()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")

Dim i As Long, j As Long
Dim LRow1 As Long, LRow2 As Long

LRow1 = ws1.Range("O" & ws1.Rows.Count).End(xlUp).Row
LRow2 = ws2.Range("B" & ws2.Rows.Count).End(xlUp).Row

For j = 1 To LRow1
    For i = 1 To LRow2
        If ws1.Cells(j, 15).Value = ws2.Cells(i, 2).Value Then
            Select Case ws2.Cells(i, 7)
                Case "IRA"
                    ws1.Cells(j, 23).Value = ws2.Cells(i, 8).Value
                    ws1.Cells(j, 24).Value = ws2.Cells(i, 15).Value
                Case "TPSD"
                    ws1.Cells(j, 25).Value = ws2.Cells(i, 8).Value
                    ws1.Cells(j, 26).Value = ws2.Cells(i, 15).Value
                Case "CA"
                    ws1.Cells(j, 27).Value = ws2.Cells(i, 8).Value
                    ws1.Cells(j, 28).Value = ws2.Cells(i, 15).Value
            End Select
        End If
    Next i
Next j

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