Вопрос по excel-vba, vba, excel, xlsm – вставить специальные значения в VBA

2

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

Это то, что у меня есть, и я получаю сообщение об ошибке с помощью специальной функции вставки. Пожалуйста помоги.

' CopyIfTrue()
Dim Col As Range, Cell As Excel.Range, RowCount As Integer
Dim nysheet As Worksheet
Set nysheet = Sheets.Add()
nysheet.Name = "T1"

Sheets("FemImplant").Select
RowCount = ActiveSheet.UsedRange.Rows.Count

Set Col = Range("I2:I" & RowCount) 'Substitute with the range which includes your True/False values
Dim i As Integer
i = 1

For Each Cell In Col      
     If Cell.Value = "True" Then                  
        Cell.Copy
        Sheets("T1").Select 'Substitute with your sheet
        Range("b" & i).Select
        ActiveSheet.Paste

        'Get sibling cell

        Sheets("FemImplant").Select
        Dim thisRow As Integer
        thisRow = Cell.Row
        Dim siblingCell As Range
        Set siblingCell = Cells(thisRow, 2)
        siblingCell.Copy
        Sheets("T1").Select 'Substitute with your sheet
        Range("a" & i).Select
        ActiveSheet.PasteSpecial Paste:=xlPasteValues

        Sheets("FemImplant").Select
         i = i + 1
    End If
Next
@ user1452091: Я бы рекомендовал использовать автофильтр вместо циклического прохождения каждого ряда. Это было бы намного быстрее & quot;) Siddharth Rout
Что значит "получить ошибку"? имею в виду? Когда вы набираете слова «ошибка»,very next thing Вы должны начать печатать - это ошибка, которую вы получаете, дополнивexact сообщение об ошибке с любыми адресами памяти. Мы не можем видеть ваш экран с того места, где мы находимся, и предоставление информации об ошибке значительно облегчает получение ответа. & quot; получить ошибку & quot; без подробностей абсолютно бесполезно для людей, не сидящих за вашим столом. :-) Пожалуйста, отредактируйте ваш вопрос и предоставьте эти детали, чтобы мы могли помочь вам решить вашу проблему. Благодарю. Ken White

Ваш Ответ

4   ответа
7

а не ActiveSheet.PasteSpecial. Это разные вещи, и ActiveSheet.PasteSpecial не знает ни одного параметра & quot; Вставить & quot ;.

ActiveSheet.Range("a" & i).PasteSpecial Paste = xlPasteValues
0

' CopyIfTrue()
Dim Col As Range, Cell As Excel.Range, RowCount As Integer
Dim nysheet As Worksheet, shtFI As Worksheet

Set shtFI = Sheets("FemImplant")
Set nysheet = Sheets.Add()
nysheet.Name = "T1"

RowCount = shtFI.UsedRange.Rows.Count
Set Col = shtFI.Range("I2:I" & RowCount)

Dim i As Integer
i = 1

For Each Cell In Col.Cells
     If Cell.Value = "True" Then
        Cell.Copy nysheet.Range("B" & i)
        nysheet.Range("A" & i).Value = _
                       shtFI.Cells(Cell.Row, 2).Value
        i = i + 1
    End If
Next
0

что предоставленный вами код работает намного быстрее, чем раньше. Однако, чтобы помочь другим понять легче, почему бы не оставить комментарий?

Я сделал это для тебя.

Sub ExtractData()

Dim selectedRange As Range ' Range to check
Dim Cell As Range
Dim iTotalRows As Integer ' Selected total number of rows
Dim i As Integer ' marker to identify which row to paste in new sheet

Dim shtNew As Worksheet
Dim shtData As Worksheet

Set shtData = Sheets("data")
Set shtNew = Sheets.Add()
shtNew.Name = "Analyzed data"

iTotalRows = shtData.UsedRange.Rows.count
Set selectedRange = shtData.Range("F2:F" & iTotalRows)

i = 1

' Check the selected column value one by one
For Each Cell In selectedRange.Cells

     If Cell.Value = "True" Then
        Cell.Copy shtNew.Range("A" & i)

        ' Copy the brand to column B in "Analyzed data" sheet
        shtNew.Range("B" & i).Value = _
                       shtData.Cells(Cell.Row, 2).Value
        i = i + 1
    End If

Next ' Check next cell in selected range

End Sub
2

Option Explicit

Sub Sample()
    Dim rRange As Range
    Dim RowCount As Integer, i As Long
    Dim nysheet As Worksheet

    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("T1").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    Set nysheet = Sheets.Add()
    nysheet.Name = "T1"

    With Sheets("FemImplant")
        RowCount = .Range("I" & Rows.Count).End(xlUp).Row

        .AutoFilterMode = False

        Set rRange = .Range("I2:I" & RowCount)

        With rRange
            .AutoFilter Field:=1, Criteria1:="True"

            .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
            nysheet.Range("B1").PasteSpecial xlPasteValues

            .Offset(1, -7).SpecialCells(xlCellTypeVisible).Copy
            nysheet.Range("A1").PasteSpecial xlPasteValues
        End With

        .AutoFilterMode = False
    End With
End Sub

Похожие вопросы