Question

我只根据宏制作循环代码，有没有其他方法可以使用？或者至少是我创建的一种简单的代码形式。

Sub xx()
Dim nom As Long
Dim bck As Workbook
Dim I As Long
Windows("LP13.xlsm").Activate
    Application.CutCopyMode = False
    Sheets("Validasi").Range("T2:T10").Copy
    Windows("backup.xlsx").Activate
    Sheets("backup").Range("F1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("LP13.xlsm").Activate
    Application.CutCopyMode = False
    Sheets("Validasi").Range("V2:X11").Copy
    Windows("backup.xlsx").Activate
    Sheets("backup").Range("G1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("LP13.xlsm").Activate
    Application.CutCopyMode = False
    For I = 1 To nom
    Sheets("Data").Range("A2:W" & I).Select
    Next
    Selection.Copy
    Windows("backup.xlsx").Activate
    Sheets("backup").Range("J1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
bck.Save
Application.Visible = False
bck.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

它看起来很难，因为重复次数过多。我想在备份中使用更简单的代码到另一个工作簿。

Answer 1

至于问题的策略部分。您可以在保存时创建文件版本备份，如http://analystcave.com/excel-quick-versioning-excel-files/

宏观部分我会尝试用变量简单地编写代码。您不需要激活任何复制数据的东西，这只是宏录制器工作的方式。备份部分要求提取功能以粘贴范围。

我会将＆＃34;中的范围命名为＆＃34;工作簿，所以你不要在代码中硬编码rng.address。您的宏并不复杂，因此命名范围将解决问题，并将为您提供文档＆＃34;你应对什么，在哪里。

如果需要，您可以创建包含要复制的源/目标范围列表的工作表，然后将其传递给＆＃34;备份管理器＆＃34;

我重构你的代码

Option Explicit

Private Type LP13Backup
    FileName  As String ' ?path
    Sht As String
    Rng As String
End Type

Public Sub LP13_BuckupManager() 'yes I know ..Manager ;)

     Dim From As LP13Backup
     Dim Backup As LP13Backup

     From.FileName = "LP13.xlsm"
     From.Sht = "Validasi"
     From.Rng = "A1:B1"

     With From
          Workbooks(.FileName).Worksheets(.Sht).Range(.Rng).Copy
     End With

     Backup.FileName = "backup.xlsx"
     Backup.Sht = "Backup"
     Backup.Rng = "F1"

     CopyToBackup Backup
End Sub

Sub CopyToBackup(ByRef Backup As LP13Backup)
     With Backup
          Workbooks(.FileName).Worksheets(.Sht).Range(.Rng).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=False
     End With
End Sub

对您的解决方案的评论意见

For I = 1 To nom
Sheets("Data").Range("A2:W" & I).Select
Next

这不是选择列中所有值的有效方法。你可以从第一个单元格下载

 Range(Range("F1"), Range("F1").End(xlDown)).Address

或像https://stackoverflow.com/a/27066381/7385538

With ws
    lastRowIndex = .Cells(.Rows.Count, "A").End(xlUp).row
End With

如何使用excel vba制作数据备份代码

1 个答案: