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