Вырежьте и вставьте ряд строк, чтобы создать новую пустую строку - PullRequest
Новая
       8

Вырежьте и вставьте ряд строк, чтобы создать новую пустую строку

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

Я составляю электронную таблицу Excel для управления проектами (моя компания не будет разыскивать лицензии для всех, чтобы у каждого был доступ к чему-либо вроде MS Project или тому подобное, и я хотел бы, чтобы каждый мог использовать все), и хотел бы, чтобы Пользователь может добавлять или удалять строки, где бы они ни указывались (я использую пользовательскую форму, чтобы упростить использование). У меня проблемы с копированием, вырезанием и вставкой строк, чтобы создать новую пустую строку.

Я хочу, чтобы пользователь указал номер строки, в которой он хочет разместить новую строку (со всеми связанными формулами и форматированием). В настоящее время я использую ячейку "C6" для ввода номера строки. Я использую модифицированный вариант кода, который успешно использовал ранее, что позволило мне скопировать и вставить новую пустую строку в нижней части таблицы. Я хотел бы, чтобы мой измененный код копировал все строки в диапазоне между строкой, указанной в ячейке "C6", и последней полной строкой, затем смещался на одну строку и вставлял, например, если значение первой строки равно 14, а последняя строка равна 50, скопируйте диапазон (14:50), сместите в строку 15 и вставьте.

Как только я получу этот бит правильно, я сделаю остальную часть кода, чтобы скопировать / вставить и очистить строку 14, чтобы дать мне новую пустую строку в формате. Я надеюсь, что код для удаления строки будет чем-то вроде этого в обратном порядке, но я вернусь к этому позже.

В настоящее время я постоянно получаю сообщение об ошибке, которое просто не понимаю - я перепробовал все, что знаю, чтобы решить эту проблему, и выполнил многочисленные поиски в Google, но ничего не работает!

Ошибка продолжает выделять «FirstRow» как проблему, но у меня есть номер в ячейке - я в растерянности: 

Dim rActive As Range
Dim FirstRow As Integer
Dim LastRow As Integer

Set rActive = ActiveCell

Application.ScreenUpdating = False

FirstRow = Range(Range("C6").Value)

LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

With Range(FirstRow & ":" & LastRow)
.Copy

With Range(FirstRow).Offset(1, 0)
.PasteSpecial xlPasteAll

On Error Resume Next

End With

End With

rActive.Select

Application.CutCopyMode = False

Application.ScreenUpdating = True

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

Ответы [ 2 ]

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

Спасибо !!Я был слишком либерален с «Рейнджем».Код теперь:

Dim rActive как диапазон Dim FirstRow как целое число Dim LastRow как целое число

Установить rActive = ActiveCell

Application.ScreenUpdating = False

FirstRow= Диапазон ("C6"). Значение

LastRow = ActiveSheet.Cells (Rows.Count, "A"). Конец (xlUp) .Row

С диапазоном (FirstRow & ":"& LastRow) .Copy

с .Offset (1, 0) .PasteSpecial xlPasteAll

При ошибке Resume Next

Конец с

Конец с

rActive.Select

Application.CutCopyMode = False

Application.ScreenUpdating = True

Работает отлично!Просто нужно сделать все остальное сейчас ...

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

В ваших типах переменных есть путаница. FirstRow = Range (Range ("C6"). Value) вернет RANGE OBJECT (на самом деле это будет ошибка, потому что нет "set").

FirstRow = Range ("C6"). Значение вернет INTEGER OR STRING.

++++++++++++++++++++++++++++++++++

Я сделал нечто подобное, это не самый звездный код, но, возможно, он даст вам некоторые идеи.

Sub AddParticipant()

    Dim msgChoice As VbMsgBoxResult
    Dim NewName As String
    Dim TargetCell As Range

    'Set Up
    ThisWorkbook.Save

    If Range("LastParticipant").Value <> "" Then
        MsgBox "The roster is full. You cannot add anymore participants.", vbCritical
        Exit Sub
    End If

    'Get Name
    NewName = Application.InputBox( _
               Prompt:="Type the participant's name as you would like it to appear on 
                         this sheet.", _
               Title:="Participant's Name", _
               Type:=2)

        'Error Message
        If NewName = "" Then
            MsgBox ("You did not enter a name.")
            Exit Sub
        End If

    'Get Location (with Data Validation)
GetTargetCell:
    Set TargetCell = Application.InputBox _
           (Prompt:="Where would you like to put this person? (Select a cell in 
                 column A)", _
            Title:="Cell Select", _
            Type:=8)
    If TargetCell.Count > 1 Then
        MsgBox "Select a single cell in Column A"
        GoTo GetTargetCell
    End If

    If TargetCell.Column <> 1 Then
        MsgBox "Select a single cell in Column A"
        GoTo GetTargetCell
    End If

    If TargetCell.Offset(-1, 0) = "" Then
        MsgBox "You must pick a contiguous cell. No blank spaces allowed!"
        GoTo GetTargetCell
    End If


    If TargetCell <> "" Then

        'Do stuff to populate rows or shift data around

    Else
        'If they picked a blank cell, you can insert new data
        TargetCell.Value = NewName

    End If


End Sub
...