Попытка удалить пустые строки в VBA с помощью командной кнопки - PullRequest
0 голосов
/ 07 января 2020

Я пытаюсь решить мою проблему, и я в значительной степени новичок ie в VBA. Я пытаюсь составить цитату из Excel, используя форму пользователя. Передача данных возможна из пользовательской формы, но у меня возникли некоторые трудности при заполнении предложения: 1. Создание новой пустой базы строк на основе ввода в пользовательской форме 2. Назначение ввода для разных строк и удаление любых пустых строк, если нет ввода.

Это моя пользовательская форма: Userform / Information input Userform / Supply input Quotation - to remove empty row in the middle

Private Sub okaybutton_Click()

'Make quotation activate
Sheet11.Activate

'Trasnfer Information sheet
Cells(2, 6).Value = DateBox.Value
Cells(6, 2).Value = "Company: " + CompanyBox.Value
Cells(8, 2).Value = "State: " + StateBox.Value
Cells(9, 2).Value = "Name: " + PICBox.Value
Cells(10, 2).Value = "Contact Number: " + ContactCustomer.Value
Cells(7, 2).Value = "Address: " + AddressBox.Value
Cells(7, 6).Value = SEBox.Value
Cells(8, 6).Value = CNBox.Value
Cells(11, 2).Value = CusEmail.Value
Cells(9, 6).Value = ACemail.Value

If PTWrequire.Value = True Then
    Cells(13, 2).Value = "PTW application or safety induction required at site"
End If
If ESDrequire.Value = True Then
    Cells(13, 2).Value = Cells(13, 2).Value & " " & " & ESD Attire required."
End If

'SupplySide information sheet

'Determine emptyRow
nextrow = WorksheetFunction.CountA(Range("B:B"))
nextrow1 = WorksheetFunction.CountA(Range("B:B")) + 1
nextrow2 = WorksheetFunction.CountA(Range("B:B")) + 2

'Dim nextrow As Long
'nextrow = Cells(Rows.Count, "A").End(xlUp).Row + 1

'flow measurement point 1
If FlowMeasure1.Value = True Then
    Cells(nextrow, 3).Value = "Flow measurement, Measures dry air flow capacity."
    If Hottap1.Value = "Yes" Then
        Cells(nextrow, 3).Value = Cells(nextrow, 3).Value & "- perform hot tapping on " & "Main header size: " & Pipesize1.Value & """."
    Else
    Cells(nextrow, 3).Value = Cells(nextrow, 3).Value & " Main header size: " & Pipesize1.Value & """."
    End If

        If Pipesize1.Value = 2 Then
        Cells(nextrow, 4).Value = "3700"
        ElseIf Pipesize1.Value = 2.5 Then
        Cells(nextrow, 4).Value = "3706"
        ElseIf Pipesize1.Value = 3 Then
        Cells(nextrow, 4).Value = "3945"
        ElseIf Pipesize1.Value = 4 Then
        Cells(nextrow, 4).Value = "3971"
        ElseIf Pipesize1.Value = 5 Then
        Cells(nextrow, 4).Value = "3971"
        ElseIf Pipesize1.Value = 6 Then
        Cells(nextrow, 4).Value = "4080"
        End If
    If SSquantity1.Value > 0 Then
    Cells(nextrow, 2).Value = SSquantity1.Value
    End If

'flow measurement point 2

    If Hottap2.Value = "Yes" Then
        Cells(nextrow1, 3).Value = "Flow measurement, Measures dry air flow capacity." & "- perform hot tapping on " & "Main header size: " & Pipesize2.Value & """."
    ElseIf Hottap2.Value = "No" Then
    Cells(nextrow1, 3).Value = Cells(nextrow1, 3).Value & " Main header size: " & Pipesize2.Value & """."
    End If

        If Pipesize2.Value = 2 Then
        Cells(nextrow1, 4).Value = "3700"
        ElseIf Pipesize2.Value = 2.5 Then
        Cells(nextrow1, 4).Value = "3706"
        ElseIf Pipesize2.Value = 3 Then
        Cells(nextrow1, 4).Value = "3945"
        ElseIf Pipesize2.Value = 4 Then
        Cells(nextrow1, 4).Value = "3971"
        ElseIf Pipesize2.Value = 5 Then
        Cells(nextrow1, 4).Value = "3971"
        ElseIf Pipesize2.Value = 6 Then
        Cells(nextrow1, 4).Value = "4080"
        End If

    If SSquantity2.Value > 0 Then
    Cells(nextrow1, 2).Value = SSquantity2.Value
    End If

'flow measurement point 3

    If Hottap3.Value = "Yes" Then
        Cells(nextrow2, 3).Value = "Flow measurement, Measures dry air flow capacity." & "- perform hot tapping on " & "Main header size: " & Pipesize3.Value & """."
    ElseIf Hottap3.Value = "No" Then
    Cells(nextrow2, 3).Value = Cells(nextrow2, 3).Value & " Main header size: " & Pipesize3.Value & """."
    End If

        If Pipesize3.Value = 2 Then
        Cells(nextrow2, 4).Value = "3700"
        ElseIf Pipesize3.Value = 2.5 Then
        Cells(nextrow2, 4).Value = "3706"
        ElseIf Pipesize3.Value = 3 Then
        Cells(nextrow2, 4).Value = "3945"
        ElseIf Pipesize3.Value = 4 Then
        Cells(nextrow2, 4).Value = "3971"
        ElseIf Pipesize3.Value = 5 Then
        Cells(nextrow2, 4).Value = "3971"
        ElseIf Pipesize3.Value = 6 Then
        Cells(nextrow2, 4).Value = "4080"
        End If

    If SSquantity3.Value > 0 Then
    Cells(nextrow2, 2).Value = SSquantity3.Value
    End If


End If

On Error Resume Next
Worksheet.Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0


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