Question

我有一本工作簿，我需要创建一个按钮点击，这将会运行evey月。我需要它按照设定的顺序在同一张纸上执行多个程序。

到目前为止，这是我所拥有的所有功能的代码。我需要一些帮助，以正确的方式对它进行排序，以便它在列表后面运行，如果你知道一种更好的编码方式，可能会整理一下。

将细胞L3值增加1
在单元格C7＆amp;中添加1个月的日期L7
将单元格N40复制并粘贴到N42
将单元格G36和粘贴值复制到G37
将单元格G49和粘贴值复制到G50
复制范围N12：N27并将值粘贴到J12：J27
saveas＆＃34;付款L3 L7。xlsm＆＃34;

这是我到目前为止的代码。

    Private Sub CommandButton3_Click()
         Dim mPay As Range
         Dim mTarget As Range
         Dim cisCurrent As Range
         Dim cisTarget As Range
         Dim taxCurrent As Range
         Dim taxTarget As Range
         Dim ttdCurrent As Range
         Dim ttdTarget As Range
         Dim TTD As String
    'Define the ranges
         Set ttdCurrent = ws.Range("N40")
          Set ttdTarget = ws.Range("N42")
         Set mPay = ws.Range("N12:N27")
          Set mTarget = ws.Range("J12:J27")
         Set cisCurrent = ws.Range("G36")
          Set cisTarget = ws.Range("G37")
         Set taxCurrent = ws.Range("G49")
          Set taxTarget = ws.Range("G50")
    'copy and paste special-add
         ttdCurrent.Copy
          ttdTarget.PasteSpecial xlValues
         ttdCurrent.Copy
          ttdTarget.PasteSpecial xlValues
         mPay.Copy
          mTarget.PasteSpecial xlValues
         cisCurrent.Copy
          cisTarget.PasteSpecial xlValues
         taxCurrent.Copy
          taxTarget.PasteSpecial xlValues
End Sub

我设法提出了一些代码，这些代码可以让客户更新日期，将L3增加1并保存文档。

增加L3，并在日期中添加1个月：

Private Sub CommandButton4_Click()
Dim rDate As Range
Dim rDate2 As Range

Set rDate = ActiveSheet.Range("C7")
Set rDate2 = ActiveSheet.Range("L7")

With ActiveSheet
    Range("L3").Value = Range("L3").Value + 1
    rDate.Value = DateAdd("m", 1, rDate.Value)
        rDate.Value = DateSerial(Year(rDate), Month(rDate) + 1, 0)
    rDate2.Value = DateAdd("m", 1, rDate2.Value)
        rDate2.Value = DateSerial(Year(rDate), Month(rDate) + 1, 0)

End With
End Sub

这是保存AS的代码：

Private Sub CommandButton6_Click()
Dim MyPath As String, MyRange As Range, MyDate As Range

MyPath = ActiveWorkbook.Path
Set MyDate = Sheets("SUB CON PAYMENT FORM").Range("L7")
Set MyRange = Sheets("SUB CON PAYMENT FORM").Range("L3") 'with the name of a cell
ThisWorkbook.SaveAs Filename:=MyPath & "\" & "Payment" & " " & MyRange.Value & " " & MyDate.Text & ".xlsm"
End Sub

您将提供的任何帮助将非常感谢!!!!

Answer 1

我在想，你是否要求一种更专业，更有效的代码编码方式？如果是这样的话，也许我很少给你建议：

在代码中使用Option Explicit。这是为了确保在使用之前声明对象。
添加Application.ScreenUpdating =False以增强您的宏观效果。
如果要将值复制到相同的单元格中，则通过在单元格中写入公式来替换它的复制宏。例如。您可以使用公式=N40对单元格（N42）进行编码，以便在单元格（N40）更新时自动复制值。间接地，您将减少代码中的变量声明。因此性能会提高。

通常情况下，我会设置＆＃34;模式＆＃34; ：workbook.worksheet到变量。例如。

Dim MyWorkbook As Workbook
Dim MyWorksheet As Worksheet
Set MyWorkbook = Workbooks("Book1.xlsm")
Set MyWorksheet = WorkbookTemplate.Sheets("WorksheetName")

仅在执行交易/任务时使用它们

最后，请使用有意义的变量来简化您将来的改进。如果您对了解更多信息感兴趣，可以阅读预订电话＆＃34;清洁代码＆＃34;

Answer 2

这就是我想出的，希望我做的一切都是正确的。

如果您发现错误或更好的编码方式，请告诉我，我一直在学习。

Private Sub CommandButton3_Click()
Dim aws As Worksheet
Dim MyPath As String, MyRange As Range, MyDate As Range
Dim rDate As Range, rDate2 As Range
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .CutCopyMode = False
    End With

Set aws = ActiveWorkbook.Sheets("SUB CON PAYMENT FORM")
Set MyRange = Sheets("SUB CON PAYMENT FORM").Range("L3")                    'Payment No
Set MyDate = Sheets("SUB CON PAYMENT FORM").Range("L7")                     'Date "MMMM YYYY"
Set rDate = ActiveSheet.Range("C7")
Set rDate2 = ActiveSheet.Range("L7")

MyPath = ActiveWorkbook.Path

ActiveWorkbook.Sheets("Details").Rows(2 & ":" & Sheets("Details").Rows.Count).ClearContents 'This clears all data below the header in Details
ActiveWorkbook.Sheets("Global").Rows(1 & ":" & Sheets("Global").Rows.Count).ClearContents   'This clears all data below in Global

With ActiveSheet
    Range("L3").Value = Range("L3").Value + 1                               'Increases Payment No# by 1
        rDate.Value = DateSerial(Year(rDate), Month(rDate) + 1, Day(29))    'Increases Date by 1 Month
        rDate2.Value = DateSerial(Year(rDate), Month(rDate) + 1, 0)         'Increases Date by 1 Month
            With aws
            .Range("N40").Copy                                              'Copies total to date Value
            .Range("N42").PasteSpecial xlValues                             'Pastes total to date Value to Total Last Payment
                With aws
                .Range("G49").Copy                                          'Copies Total VAT to Date
                .Range("G50").PasteSpecial xlValues                         'Pastes Total VAT to Date into Last Payment
                .Range("G36").Copy                                          'Copies This Months Labour
                .Range("G37").PasteSpecial xlValues                         'Pastes This Months Laboue into Last Payment
                End With
                With aws
                .Range("N12:N27").Copy                                      'Copies CC Code Gross Value
                .Range("J12:J27").PasteSpecial xlValues                     'Pastes CC Code Gross Value into Previous
                End With
            End With
    Range("A1").Activate                                                    'Selects Cell A1
End With

ThisWorkbook.SaveAs Filename:=MyPath & "\" & "Payment" & " " & MyRange.Value & " " & MyDate.Text & ".xlsm" 'This saves a new document in our naming convention

End Sub

Excel VBS在同一张纸上完成了另一个这样的操作

2 个答案: