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

Question

Я хочу вставить пустую строку, если выбранная строка не пуста, и перенести туда данные.

Я могу выбрать определенную c строку (x) после того, как мне нужно вставить пустая строка, если в столбцах 4, 5, 6 и 7 есть данные. Мне нужны эти новые данные для переноса в строку в.

Private Sub CommandButton1_Enter()

    Dim emptyRow As Long
    Dim ws As Worksheet
    Set ws = ActiveSheet
    ActiveSheet.Name = "Micrux"

    Dim x As Long
    Dim y As Long
    Dim found As Boolean

    With Sheets("Micrux")
        x = .Range("A" & .Rows.Count).End(xlUp).Row
        For y = 1 To x
            If .Cells(y, 1).Text = ComboBox1.Value Then
                found = True

               .Cells(y, 4) = TextBox1.Text
               .Cells(y, 7) = TextBox2.Text
               .Cells(y, 6) = TextBox3.Text
               .Cells(y, 5) = ComboBox2.Value

            End If
        Next y
    End With

    Unload Me
End Sub

Answer 1

Я предположил, что если нет совпадения, данные должны быть добавлены ниже последней строки. Направление поиска идет снизу вверх, поэтому, если есть блок записей с тем же значением colA, новая запись добавляется ниже блока. Примечание. Я использовал метод _Click, а не _Enter. В окнах сообщений отображаются обновленные строки, при необходимости вы можете закомментировать их.

Просмотрите документы по объектной модели для insert и find * 1006. * методы на объектах диапазона.

Private Sub CommandButton1_Click()

Dim emptyRow As Long
Dim ws As Worksheet
Set ws = ActiveSheet
ActiveSheet.Name = "Micrux"

Dim iLastRow As Long, iFound As Long
Dim rng, bEmpty As Boolean, c As Integer
bEmpty = True

With ws
   iLastRow = .Range("A" & .Rows.Count).End(xlUp).Row

   ' search column starting at bottom
   Set rng = .Range("A1:A" & iLastRow + 1).Find(ComboBox1.Value, _
        After:=.Range("A" & iLastRow + 1), _
        LookIn:=xlValues, _
        lookat:=xlWhole, _
        searchorder:=xlByRows, _
        SearchDirection:=xlPrevious)

   If rng Is Nothing Then
       iFound = iLastRow + 1 ' add to end
   Else
       iFound = rng.Row
       ' check empty
       For c = 4 To 7
         If Len(.Cells(iFound, c)) > 0 Then bEmpty = False
       Next
       ' insert if not empty
       If bEmpty = False Then
          iFound = iFound + 1
         .Cells(iFound, 1).EntireRow.Insert xlShiftDown
         MsgBox "Row inserted at " & iFound, vbInformation
       End If
   End If
   ' transfer data
   .Cells(iFound, 1).Value = ComboBox1.Value
   .Cells(iFound, 4).Value = TextBox1.Text
   .Cells(iFound, 7).Value = TextBox2.Text
   .Cells(iFound, 6).Value = TextBox3.Text
   .Cells(iFound, 5).Value = ComboBox2.Value

   MsgBox "Data copied to " & iFound, vbInformation

End With

End Sub

Answer 2

Дайте мне знать, если это работает для вас. Ваша цель была мне не совсем понятна, поэтому, если она не соответствует вашей конкретной цели c, дайте мне знать.

Я оставил комментарии в коде, чтобы объяснить, что я делаю.

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

Option Explicit

Public Sub test()
    'i prefer to keep all my variable declarations at the top
    'unless i have a specific reason for not doing so
    Dim emptyRow As Long
    Dim ws As Worksheet
    Dim y As Long
    Dim wsHeight As Long
    Dim found As Boolean

    'just some constants i made to make testing easier for me
    Const wsName As String = "Micrux"
    Const combo1Val As String = "some text"
    Const textbox1Val As String = "textbox1 text"
    Const textbox2Val As String = "textbox2 text"
    Const textbox3Val As String = "textbox3 text"
    Const combo2Val As String = "combo2 text"

    'dont set references to sheets like this
'    Set ws = ActiveSheet
'    ActiveSheet.Name = "Micrux"

    'this is better method
    Set ws = ThisWorkbook.Worksheets(wsName)
    'or alternatively this works too
'    Set ws = ThisWorkbook.Worksheets(someWorksheetNumber)

    With ws
        'descriptive variables are easier to read than non-descriptive
        'variables
        wsHeight = .Range("A" & .Rows.Count).End(xlUp).Row

        'you'll need to keep changing wsHeight, so a for loop
        'won't suffice
        y = 1
        While y <= wsHeight
            If .Cells(y, 1).Value = combo1Val Then
                'dont assign values like this
'                .Cells(y, 4) = textbox1Val
'                .Cells(y, 7) = textbox2Val
'                .Cells(y, 6) = textbox3Val
'                .Cells(y, 5) = combo2Val

                'assign values like this
                .Cells(y, 4).Value = textbox1Val
                .Cells(y, 7).Value = textbox2Val
                .Cells(y, 6).Value = textbox3Val
                .Cells(y, 5).Value = combo2Val

                'insert a blank row
                .Cells(y, 1).Offset(1, 0).EntireRow.Insert shift:=xlDown

                'since you inserted a blank row, you need to also
                'increase the worksheet height by 1
                wsHeight = wsHeight + 1
            End If

            y = y + 1
        Wend
    End With

    'idk what this does but i dont like the looks of it
'    Unload Me
End Sub

Надеюсь, это поможет