#excel #vba
Вопрос:
Он все, я продвигаюсь в своем первом крупном проекте VBA, у меня есть несколько флажков для выбора типа обуви, который затем будет использовать значения выпадающих списков для записи каждого размера с данными в новой строке. Я пытаюсь реализовать это с помощью командной кнопки (commandbuttonapply), но могу заставить ее вставить только первую. В окончательном проекте будет около 67 флажков.
Private Sub CommandButtonApply_Click()
Call Checkboxes
End Sub
Sub Checkboxes()
If Me.CheckBox9k.Value = True And Me.CheckBox95k.Value = True Then
Else
If Me.CheckBox9k.Value = True Then
Call CheckBox9ktrue
ElseIf Me.CheckBox95k.Value = True Then
Call checkbox95ktrue
Exit Sub
End If
End If
End Sub
Sub checkbox95ktrue()
'''Input
Dim ws As Worksheet
Dim LastRow As Long, RowInsert As Long
Set ws = ThisWorkbook.Worksheets("stock")
With ws
LastRow = .Cells(Rows.Count, "A").End(xlUp).row
RowInsert = .Range("A1:A" amp; LastRow).Find("*", .Cells(LastRow, "A"), xlValues, , , xlPrevious).row
RowInsert = RowInsert 1
RowInvert = RowInsert - 1
'add the uk size input code here
'''Checkbox based search
''Start
If Me.comboboxbrand.Value = "" Then
MsgBox "please enter a brand", vbInformation
Exit Sub
End If
If Me.comboboxgender.Value = "" Then
MsgBox "please enter an item gender", vbInformation
Exit Sub
End If
If Me.comboboxclosure.Value = "" Then
MsgBox "please enter a closure type", vbInformation
Exit Sub
End If
If Me.comboboxmaterial.Value = "" Then
MsgBox "please enter an upper material type", vbInformation
Exit Sub
End If
'If Me.comboboxuksize.Value = "" Then
'MsgBox "please enter the uk size", vbInformation
'Exit Sub
'End If
If Me.comboboxmodel.Value = "" Then
MsgBox "please enter a model type", vbInformation
ElseIf Me.CheckBox9k.Value = True Then
''''This has to match the number of rows input below
.Cells(RowInsert, "A").Resize(1, 8).Value = Array( _
Me.txtDate.Text, _
Me.textboxparentsku.Text, _
Me.comboboxbrand.Text, _
Me.comboboxclosure.Text, _
Me.comboboxgender.Text, _
Me.comboboxmaterial.Text, _
Me.comboboxmodel.Text, _
Me.ComboBoxcolour.Text _
)
ws.Range("I" amp; RowInsert).Value = CheckBox95k.Caption
'ElseIf Me.CheckBox9k.Value = False Then .Cells(RowInvert, "A").Resize(1, 9).Value = ""
End If
''Finish
Set ws = Nothing
End With
End Sub
Sub CheckBox9ktrue()
'''Input
Dim ws As Worksheet
Dim LastRow As Long, RowInsert As Long
Set ws = ThisWorkbook.Worksheets("stock")
With ws
LastRow = .Cells(Rows.Count, "A").End(xlUp).row
RowInsert = .Range("A1:A" amp; LastRow).Find("*", .Cells(LastRow, "A"), xlValues, , , xlPrevious).row
RowInsert = RowInsert 1
RowInvert = RowInsert - 1
'add the uk size input code here
'''Checkbox based search
''Start
If Me.comboboxbrand.Value = "" Then
MsgBox "please enter a brand", vbInformation
Exit Sub
End If
If Me.comboboxgender.Value = "" Then
MsgBox "please enter an item gender", vbInformation
Exit Sub
End If
If Me.comboboxclosure.Value = "" Then
MsgBox "please enter a closure type", vbInformation
Exit Sub
End If
If Me.comboboxmaterial.Value = "" Then
MsgBox "please enter an upper material type", vbInformation
Exit Sub
End If
'If Me.comboboxuksize.Value = "" Then
'MsgBox "please enter the uk size", vbInformation
'Exit Sub
'End If
If Me.comboboxmodel.Value = "" Then
MsgBox "please enter a model type", vbInformation
ElseIf Me.CheckBox9k.Value = True Then
''''This has to match the number of rows input below
.Cells(RowInsert, "A").Resize(1, 8).Value = Array( _
Me.txtDate.Text, _
Me.textboxparentsku.Text, _
Me.comboboxbrand.Text, _
Me.comboboxclosure.Text, _
Me.comboboxgender.Text, _
Me.comboboxmaterial.Text, _
Me.comboboxmodel.Text, _
Me.ComboBoxcolour.Text _
)
ws.Range("I" amp; RowInsert).Value = CheckBox9k.Caption
'ElseIf Me.CheckBox9k.Value = False Then .Cells(RowInvert, "A").Resize(1, 9).Value = ""
End If
''Finish
Set ws = Nothing
End With
End Sub
Комментарии:
1. Не связано с вашим запросом, но ваша работа будет намного проще, если вы будете использовать последовательные отступы и не будете включать случайные избыточные пробелы.
2. Спасибо, я демонстративно демонстрирую свои любительские навыки, чтобы получить хорошую практику до того, как сформируются вредные привычки, В VBA это не так разнесено, как сейчас.
3. Вы идете прямо от а
Then
доElse
в. Ты что, пропустил какой-то шаг?4. Ах, это остатки того, что я пробовал разные вещи, спасибо за место.
5. Просто используйте
RowInsert = LastRow 1
, иElseIf Me.CheckBox9k.Value = True Then
в концеSub checkbox95ktrue()
у вас будет распространенная ошибка копирования/вставки.
Ответ №1:
Вам не нужно иметь подменю для каждого флажка, вы можете использовать Me.Controls(variable)
Option Explicit
Private Sub CommandButtonApply_Click()
Call Checkboxes
End Sub
Sub Checkboxes()
Dim ar, data(8) As String, n As Integer, i As Integer, msg As String
ar = Array("brand", "closure", "gender", "material", "model", "colour")
' validate inputs
data(0) = Me.TxtDate.Text
data(1) = Me.TextBoxparentsku.Text
For n = 0 To UBound(ar)
data(n 2) = Me.Controls("ComboBox" amp; ar(n)).Value
If data(n 2) = "" Then
msg = msg amp; vbCrLf amp; ar(n)
End If
Next
' any blanks
If msg <> "" Then
MsgBox "Please enter a value in :" amp; msg, vbExclamation
Exit Sub
End If
' count number of checkboxes checked
Dim arChk, s As String
arChk = Array("9k", "95k")
For n = 0 To UBound(arChk)
s = "CheckBox" amp; arChk(n)
If Me.Controls(s).Value = True Then
data(8) = Me.Controls(s).Caption ' Col I
i = i 1
End If
Next
' only 1 allowed
If i = 0 Then
MsgBox "No checkbox", vbExclamation
Exit Sub
ElseIf i > 1 Then
MsgBox "More than 1 checkbox", vbExclamation
Exit Sub
End If
' update worksheet
Dim ws As Worksheet, LastRow As Long
Set ws = ThisWorkbook.Worksheets("stock")
With ws
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Cells(LastRow 1, "A").Resize(1, 9).Value = data
End With
End Sub
Комментарии:
1. Это вызвало много проблем, спасибо, что я включил это, и это значительно упростило ситуацию.