Скопировать всю строку на другой лист с учетом экземпляра в строке - PullRequest
1 голос
/ 20 мая 2019

У меня большой объем данных на листе, и я хочу скопировать и вставить все строки, содержащие "HVT", на другой лист. Я новичок в VBA, и я думаю, что мой код ищет всю ячейку, а не содержимое ячейки. Например, если в ячейке указано только "HVT", это будет работать, но в ячейках есть несколько строк. Примером чего-то, что может быть в ячейке, может быть что-то вроде "mechanical system damper HVT purchased"

Private Sub CommandButton1_Click()
    a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To a
        If Worksheets("Sheet1").Cells(i, 11).Value = "HVT" Then
            Worksheets("Sheet1").Rows(i).Copy
            Worksheets("Sheet2").Activate
            b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
            Worksheets("Sheet2").Cells(b + 1, 1).Select
            ActiveSheet.Paste
            Worksheets("Sheet1").Activate
        End If
    Next

    Application.CutCopyMode = False
    ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Select
End Sub

Ответы [ 2 ]

1 голос
/ 20 мая 2019

Excel, если операторы принимают символы подстановки, поэтому вам просто нужно знать, хотите ли вы соответствовать целому слову "HVT" или нет:

Совпадение всего слова:

If Worksheets("Sheet1").Cells(i, 11).Value Like "* HVT *" Or Worksheets("Sheet1").Cells(i, 11).Value Like "HVT *" Or Worksheets("Sheet1").Cells(i, 11).Value Like "* HVT" Then

Или совпадениелюбой экземпляр HVT («xHVTx» возвращает true):

If Worksheets("Sheet1").Cells(i, 11).Value Like "*HVT*" Then

Будет работать

0 голосов
/ 20 мая 2019

Ниже обновлен код:

Sub transferHVT()

Dim mySH As Worksheet
Set mySH = ThisWorkbook.Sheets("Sheet1")
Dim sSH As Worksheet
Set sSH = ThisWorkbook.Sheets("Sheet2")

Application.ScreenUpdating = False

Dim sh2_Row As Integer
sh2_Row = 1
For a = 2 To mySH.Cells(Rows.Count, 11).End(xlUp).Row
    If InStr(mySH.Cells(a, 11).Value, "HVT") <> 0 Then
        'Loop through all the column
        For b = 1 To mySH.Cells(a, Columns.Count).End(xlToLeft).Column
            sSH.Cells(sh2_Row, b).Value = mySH.Cells(a, b).Value
        Next b
        sh2_Row = sh2_Row + 1
    End If
Next a

Application.ScreenUpdating = True

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