Перенести ввод пользовательской формы в диапазон ячеек - PullRequest
Новая
       18

Перенести ввод пользовательской формы в диапазон ячеек

0 голосов
/ 26 сентября 2018

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

Я нахожусь в процессе создания простой базы данных, где пользователям придется вводить значения на основе раскрывающихся меню.Исключением является столбец AB , в котором содержится пользовательская форма, в которой оператору необходимо будет ввести два числовых значения, например, «Незначительные выводы» и «Основные выводы», оба в диапазоне от 1 до 25.

В настоящее время пользовательская форма автоматически запускается, как только пользователь выбирает определенный диапазон ячеек AB14: AB200

Затем пользователь нажимает кнопку с названием caclculate severity который должен затем перенести два значения в два столбца AI & AJ

Проблема, с которой я столкнулся, заключается в следующем: пользователь может вызватьuserform из ячейки AB56 , введите два значения, нажмите рассчитать серьезность , но вывод всегда будет транспонирован в первые строки диапазона (AI14 и AJ14) вместо (AI56 &AJ56).

Я приложил образец моего кода вместе со скриншотом базы данных.

DATABASE SCREENSHOT

Private Sub Calculateseveritybutton_Click()

Worksheets("International CCU Tracker").Activate
Set xrg = Worksheets("International CCU Tracker").Range("AB14:AB200")

For Each xcell In xrg

' replace the sheet name and range A2 or B2 with yours
If Textbox1.Value = "0-25" And Textbox2.Value = "0-25" Then
MsgBox ("Please enter a Minor and Major finding value")

ElseIf Textbox1.Value <> "0-25" And Textbox2.Value = "0-25" Then
Sheets("International ccu tracker").Range("AI" & xcell.Row).Value = Textbox1.Value
MsgBox ("Please enter a Major finding value")

ElseIf Textbox1.Value = "0-25" And Textbox2.Value <> "0-25" Then
Sheets("International ccu tracker").Range("AJ" & xcell.Row).Value = Textbox2.Value
MsgBox ("Please enter a Minor finding value")


ElseIf Textbox1.Value <> "0-25" And Textbox2.Value <> "0-25" Then
Worksheets("International ccu tracker").Range("AI" & xcell.Row).Value = Textbox1.Value
Worksheets("International ccu tracker").Range("AJ" & xcell.Row).Value = Textbox2.Value
MsgBox ("Rating calculated")

Textbox3.Font.Size = 14
Textbox3.TextAlign = 2

End If
Next xcell
Exit Sub
End Sub

Это код триггера пользовательской формы 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim question As Integer

    If Not Intersect(Target, Me.Range("Userformrange")) Is Nothing Then

        question = MsgBox("Would you like to add or edit a rating?", vbYesNo)
        If question = vbYes Then
            UserForm1.Show
        Else 
            Exit Sub
        End If
    End If
End Sub

1 Ответ

0 голосов
/ 26 сентября 2018

Не проверено:

Рабочий лист: 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rng As Range
    Set rng = Intersect(Target, Me.Range("Userformrange"))

    If Not rng Is Nothing Then
        If MsgBox("Would you like to add or edit a rating?", vbYesNo) = vbYes Then
            ' "TheCell" is a public global in your userform (or make a property Get/Let)
            Set UserForm1.TheCell = rng.Cells(1) 'only dealing with one row at a time...
            UserForm1.Show
        Else
            Exit Sub
        End If
    End If
End Sub

Форма пользователя: 

Public TheCell As Range 'public variable in your form

Private Sub Calculateseveritybutton_Click()
    If Textbox1.Value = "0-25" Or Textbox2.Value = "0-25" Then
        MsgBox "Minor and Major finding values are both required!", vbExclamation
    Else
        With TheCell.EntireRow
            .Cells(1, "AI").Value = Textbox1.Value 'Cells is *relative* here...
            .Cells(1, "AJ").Value = Textbox2.Value
            MsgBox ("Rating calculated")
            Textbox3.Font.Size = 14
            Textbox3.TextAlign = 2
        End With
    End If
End Sub
...