如何修改按钮指定宏的代码

zdh8083

这里是一个大神的拆分表格，记得有一次改过保存的名称，现在无论是按ALT+F8或者ALT+F11都无法再修改了

dgerwin

菜单选开发工具/宏/点击宏/编辑,可以啊

zdh8083

请问您昨晚说的：菜单选开发工具/宏/点击宏/编辑  ，是不是打开这个界面 ？

还有一个更底层的，可以修改保存名称、路径之类的代码，已经不知道如何进入了。。。

dgerwin

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim arr As Variant
Dim i, s As Integer
Dim brr()
Dim wb, wb1 As Workbook
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim sh As Worksheet
If ComboBox1.Text = "" Then
MsgBox "请输入标题行数"
Exit Sub
End If
If ComboBox2.Text = "" Then
MsgBox "请输入拆分列"
Exit Sub
End If
If OptionButton1.Value = False And OptionButton2.Value = False And OptionButton3.Value = False Then
MsgBox "请选择拆分类型"
Exit Sub
End If
If OptionButton1.Value = True Then
For Each sh In Worksheets
If sh.Name <> ActiveSheet.Name Then sh.Delete
Next sh
End If
arr = ActiveSheet.Range("a1").CurrentRegion
For i = ComboBox1.Text + 1 To UBound(arr)
If Not d.exists(arr(i, ComboBox2.Text)) Then
Set d(arr(i, ComboBox2.Text)) = ActiveSheet.Range("a" & i).Resize(1, UBound(arr, 2))
Else
Set d(arr(i, ComboBox2.Text)) = Union(d(arr(i, ComboBox2.Text)), ActiveSheet.Range("a" & i).Resize(1, UBound(arr, 2)))
End If
Next i
If OptionButton3.Value = True Then
Application.SheetsInNewWorkbook = d.Count
Set wb1 = Workbooks.Add
i = 1
For Each k In d.keys
wb1.Worksheets(i).Name = k
i = i + 1
Next k
End If
x = d.keys
For k = 0 To UBound(x)
If OptionButton1.Value = True Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = x(k)
   ThisWorkbook.Worksheets(1).Rows("1:" & ComboBox1.Text).Copy ActiveSheet.[a1]
d.items()(k).Copy ActiveSheet.[a3]
    For i = 1 To UBound(arr, 2)
   For Each sh In ThisWorkbook.Worksheets
If sh.Name <> x(k) Then
Sheets(x(k)).Columns(i).ColumnWidth = sh.Columns(i).ColumnWidth
  End If
  Next sh
  Next i
  End If
If OptionButton2.Value = True Then
Application.SheetsInNewWorkbook = 1
  Set wb = Workbooks.Add
With wb.Worksheets(1)
ThisWorkbook.Worksheets(1).Rows("1:" & ComboBox1.Text).Copy .[a1]
d.items()(k).Copy .[a3]
  For i = 1 To UBound(arr, 2)
  .Columns(i).ColumnWidth = ThisWorkbook.ActiveSheet.Columns(i).ColumnWidth
  Next i
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & "2019年06月部门员工工资-" & x(k)
wb.Close
End With
End If
If OptionButton3.Value = True Then
ThisWorkbook.Worksheets(1).Rows("1:" & ComboBox1.Text).Copy wb1.Worksheets(x(k)).[a1]
d.items()(k).Copy wb1.Worksheets(x(k)).[a3]
    For i = 1 To UBound(arr, 2)
  wb1.Sheets(x(k)).Columns(i).ColumnWidth = ThisWorkbook.ActiveSheet.Columns(i).ColumnWidth
  Next i
End If
Next k
If OptionButton3.Value = True Then
wb1.SaveAs Filename:=ThisWorkbook.Path & "\" & "拆分数据表.xlsx"
wb1.Close False
End If
End
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
End
End Sub
Private Sub UserForm_Initialize()
Me.ComboBox1.List = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11")
Me.ComboBox2.List = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26")
End Sub

dgerwin

窗体/点击命令按钮一

zdh8083

终于找到了，非常感谢！