Excel 按钮，多选框提交实例

原創 moscot_wu 2020-06-07 05:22

用户有一个Excel，多个sheet，然后首页是一些下拉框和填充框，所有的数据在其他sheet页，客户非常苦恼每次需要在各页找到相关的内容，然或填写到首页，并且首页填写的内容可以自动填充到各个Sheet页。

方法：使用Excel的VB脚本实现，首页信息填充后，点击按钮实现提交的功能。脚本如下:

Private Sub CheckBox1_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox1.Caption
With Me.CheckBox1
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub

Private Sub CheckBox10_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox10.Caption
With Me.CheckBox10
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub

Private Sub CheckBox11_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox11.Caption
With Me.CheckBox11
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub

Private Sub CheckBox12_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox12.Caption
With Me.CheckBox12
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub

Private Sub CheckBox13_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox13.Caption
With Me.CheckBox13
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub

Private Sub CheckBox14_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox14.Caption
With Me.CheckBox14
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub

Private Sub CheckBox15_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox15.Caption
With Me.CheckBox15
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub

Private Sub CheckBox16_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox16.Caption
With Me.CheckBox16
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub

Private Sub CheckBox17_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox17.Caption
With Me.CheckBox17
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub

Private Sub CheckBox18_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox18.Caption
With Me.CheckBox18
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub

Private Sub CheckBox2_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox2.Caption
With Me.CheckBox2
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub

Private Sub CheckBox3_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox3.Caption
With Me.CheckBox3
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub

Private Sub CheckBox4_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox4.Caption
With Me.CheckBox4
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub

Private Sub CheckBox5_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox5.Caption
With Me.CheckBox5
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub

Private Sub CheckBox7_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox7.Caption
With Me.CheckBox7
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub

Private Sub CheckBox8_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox8.Caption
With Me.CheckBox8
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub

Private Sub CheckBox9_Click()
Dim n As Integer
Dim st As String
st = Me.CheckBox9.Caption
With Me.CheckBox9
n = Me.UsedRange.Rows.Count + 1
If .Value Then
Me.Range("A" & n).EntireRow.Insert
Me.Range("A" & n) = "N/A"
Me.Range("B" & n) = Cells(2, 3)
Me.Range("C" & n) = st
Me.Range("D" & n) = "null"
Me.Range("E" & n) = "null"
Else
For i = 29 To 50
If Me.Range("C" & i) = st Then
Me.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
End If
Next
End If
End With
End Sub


'entireRow属性返回一个range对象==指定1个或多个单元格所在的整行(可能是多行),用法：获取选中单元格所处的整行中的指定行列位置的单元格值：
'ActiveCell.EntireRow.Cells(1,1).Value
'EntireColumn返回指定单元格所在的整列
'Me.Range("A" & n).EntireRow.Insert
'引用range对象：range("A1"):引用当前活动表的A1单元格，range("A1","A5")/Range("A1:A5"):引用这块区域，range("总计")：引用当前sheet中名称为总计的单元格
'activeSheet.cells(3,4):引用当前sheet中第3行第4列的单元格：cells属性只能引用1个单元格,range(cells(1,2),cells(10,5)),[A1:D10]:引用A1：D10单元格区域
'引用行和列：activeSheet.rows/columns("3:3"):引用当前sheet的第3行，
'union可将不连续的多个单元格选中，Application.Union(Range("A1:A10"),Range("D1:D5"))
'copy命令：sheets(1).range("7").copy sheets(1).range("b20")---仅复制值


Private Sub CommandButton1_Click()
Dim row_1 As Integer
row_1 = 19
Dim str_1 As String
Dim row_19 As Range
Dim row_24 As Range
Dim row_19_variant As Variant
Dim row_last_before As Integer
Dim row_last_refer_reports As Integer
Dim row_last As Range
Dim row_last_1 As Range
Dim row_last_2 As Range
Dim rang_A29_E45 As Range
'Dim r_row_last_1st_cell As Variant


'MsgBox "欢迎开始载入"
If vbOK = MsgBox("Confirm Submission", vbOKCancel, "prompt") Then
  Application.ScreenUpdating = False
  '''''''
  '执行的代码
  '获取第19整行
  'row_19 = ActiveSheet.Rows(19)
  'str_1 = Me.Range("A" & row_1).EntireRow.Value
  'row_19 = Range("A19:K19").EntireRow
  'Debug.Print row_19
  '获取第19行第B列的值
  'Set row_19 = Sheets("Input Form").[a19:k19]
  Set row_19 = Range("a19:k19")
  Set row_20 = Range("a20:k20")
  'Debug.Print row_19.
  Set row_24 = Range("a24:h24")
  Set rang_A29_E45 = Range("a29:e45")
  row_last_before = Sheets("REFER_REPORTS").UsedRange.Rows.Count
  row_last_refer_reports = row_last_before + 1

  row_last_REFER_RPT_SRC_DETAIL = Sheets("REFER_RPT_SRC_DETAIL").UsedRange.Rows.Count + 1
  row_last_RPT_ELEM_REL = Sheets("RPT_ELEM_REL").UsedRange.Rows.Count + 1
   
  'Set row_last_before = Sheets("REFER_REPORTS").Range("A" & row_last_before_refer_reports, "K" & row_last_before_refer_reports)
  'Debug.Print row_last_refer_reports
  'Set row_last = Sheets("REFER_REPORTS").Range("A313 : K313")
  Set row_last = Sheets("REFER_REPORTS").Range("A" & row_last_refer_reports, "K" & row_last_refer_reports)
  'r_row_last_1st_cell = row_last.Cells(1, 1)
  Set row_last_1 = Sheets("REFER_RPT_SRC_DETAIL").Range("A" & row_last_REFER_RPT_SRC_DETAIL, "H" & row_last_REFER_RPT_SRC_DETAIL)
  Set row_last_2 = Sheets("RPT_ELEM_REL").Range("A" & row_last_RPT_ELEM_REL, "E" & row_last_RPT_ELEM_REL + 16)
    'row_19.Copy Sheets("REFER_REPORTS").Range("A313 : K313")
    'Range("A19", Range("a19").Offset(0, 10)).Copy row_20
If Sheets("REFER_REPORTS").Range("B" & row_last_refer_reports - 1).Value <> Sheets("Input Form").Range("B19").Value Then
   ' If row_last_before.Cells(1, 2).Value <> row_19.Cells(1, 2).Value Then
    row_last = row_19.Value '将19行值贴到REFER_REPORTS表中,只取值不取格式
    Worksheets("REFER_REPORTS").Activate 'select前一定要先选定当前激活哪个工作表
    row_last.Cells(1, 1).Select
    Selection.Offset(-1, 0).Select '选中当前单元格向上至最后一个非空单元格
    'row_last.Cells(1, 1).Offset(-1, 0).Select '最后一行第1个单元格的上一个非空单元格被选中,再从选中对象中取单元格值
    row_last.Cells(1, 1).Value = Selection.Value + 1 '将上一个单元格值加1后赋给最后一个单元格值
    '往sheet：Input Form的c2赋值
    Sheets("Input Form").Range("c2").Value = row_last.Cells(1, 1).Value '给c2单元格赋递增值
     row_last_1 = row_24.Value '将24行值贴到REFER_RPT_SRC_DETAIL表中
     Worksheets("REFER_RPT_SRC_DETAIL").Activate '在下面进行select前要先将当前被select的sheet被选定为当前活动表状态，否则系统无法选定区域
     row_last_1.Cells(1, 1).Select
     row_last_1.Cells(1, 1).Offset(-1, 0).Select
     row_last_1.Cells(1, 1).Value = Selection.Value + 1
     Worksheets("RPT_ELEM_REL").Activate
     row_last_2 = rang_A29_E45.Value '将A29到e45区域的所有单元格值赋值到sheet表：RPT_ELEM_REL的a2753到2769
     row_last_2.Cells(1, 1).Select
     row_last_2.Cells(1, 1).Offset(-1, 0).Select '选中最后一行的第一个单元格的上一格的值即除新增行外的最后一个id值
     Dim i As Long
     For i = 1 To 17
        If row_last_2.Cells(i, 1).Value = "N/A" Then
            row_last_2.Cells(i, 1).Value = Selection.Value + i
        End If
     Next

     '解决循环次数的问题：贴过来的这块区域中被使用的行数值==循环次数----获取指定区域内被使用的行数，行数即循环次数

'     row_last_2.Cells(1, 1).Value = Selection.Value + 1 '最后1个id值加1~n依次赋给新增区域从1行1列到n行1列的单元格值
'     row_last_2.Cells(2, 1).Value = Selection.Value + 2
'     row_last_2.Cells(3, 1).Value = Selection.Value + 3
'     row_last_2.Cells(4, 1).Value = Selection.Value + 4
  Application.ScreenUpdating = True
  MsgBox "Submit completed."
  Worksheets("Input Form").Activate
Else
     MsgBox "Duplicate Records,Do't Repeat."
    Worksheets("Input Form").Activate

End If
Else
  MsgBox "Cancel Submission."
End If


End Sub

 

發表評論
所有評論
還沒有人評論，想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章

Excel 实战

moscot_wu 2019-07-28 12:52:01