VBA - ЕСЛИ ячейка в столбце A = Значение, затем скопировать столбцы B, C, D той же строки в новый лист

Question

Я изо всех сил пытаюсь найти любую информацию, которую я могу использовать на этом.Я много искал, прежде чем приехать сюда, и любая помощь будет принята с благодарностью.У меня есть некоторые базовые VBA, но это немного продвинутый, чтобы даже знать, с чего начать с нуля.

Если ячейка в столбце A = значение, то скопируйте столбцы B, C, D исходного листав столбцы A, B, C нового рабочего листа.

Вот пример

Исходный рабочий лист

Новый рабочий лист

Спасибо!

Answer 1

Вы должны задать вопрос более четко, чтобы мы могли помочь вам.И каждый шаг прост.Просто не знаю, что тебе действительно нужно.Вы сказали, что сделали несколько VBA, поэтому я предполагаю, что у вас есть основы.Для части «столбец A = значение» я предполагаю, что вы спрашиваете, содержится ли значение в столбце A где-либо.Для «скопировать столбец B, C, D в столбец A, B, C на новом листе».Я предполагаю, что вы копируете весь столбец.Следующий код поможет вам организовать ваши мысли и поможет вам начать.

Sub YourMacr(ByVal compare_value)
    Dim arr As Variant, srcSheet As Worksheet, destSheet As Worksheet
    Set srcSheet = Sheets("xxxxxx")
    Set destSheet = Sheets("xxxxx")
    arr = srcSheet.Columns("A:A")
    If IsInArray(compare_value, arr) Then
        srcSheet.Columns("B:D").Copy
        destSheet.Columns("A:C").PasteSpecial xlPasteValues
    End If
End Sub

Private Function IsInArray(target As Variant, arr As Variant) As Boolean
    Dim ele As Variant
    On Error GoTo IsInArrayError:
    For Each ele In arr
        If ele = target Then
            IsInArray = True
            Exit Function
        End If
    Next ele
    Exit Function
IsInArrayError:
    On Error GoTo 0
    IsInArray = False
End Function

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

Public Sub YourMacr(ByVal compare_val)
    Dim srcSheet As Worksheet, destSheet As Worksheet

    Set srcSheet = ThisWorkbook.Sheets("your source sheet name ..........")
    Set destSheet = ThisWorkbook.Sheets("your new sheet name ...........")

    'Determine the last row in the source sheet, here I assume your data is on continues range and start from row 1
    Dim lastRow As Long
    lastRow = srcSheet.Range("A1").End(xlDown).Row

    'Loop through the column A, find which rows has value wanted
    ReDim idx_arr(1 To lastRow)
    Dim cnt As Integer
    cnt = 0
    For i = 1 To lastRow
        If srcSheet.Cells(i, 1).Value = compare_value Then
            cnt = cnt + 1
            idx_arr(cnt) = i
        End If
    Next

    If cnt = 0 Then Exit Sub

    For i = 1 To cnt
        destSheet.Cells(i, "A").Value = srcSheet.Cells(idx_arr(i), "B")
        destSheet.Cells(i, "B").Value = srcSheet.Cells(idx_arr(i), "C")
        destSheet.Cells(i, "C").Value = srcSheet.Cells(idx_arr(i), "D")
    Next i

    Dim targetRows(1 To 10000)

End Sub