"SkipBlanks" 用于当您有一个要复制的范围并且当您粘贴到一个新位置时,您不希望使用空白/空数据获取以前的 values overwritten。但是,它不会从您的范围中排除任何单元格。因此,您仍然会得到“空”行。
1A - 您可以像这样在 VBA 中构建范围:
Range("S73:S128") -> Range(Cells(S73), Cells(S128)) ->
Range(Cells(row number, column number), Cells(row number, column number)) ->
Range(Cells(73, 19), Cells(128, 19))
2A - 我们可以像这样参考不同的工作簿:
Dim Wkb As Workbook
Set Wkb = ThisWorkbook
Dim MainSheet As Worksheet
Set MainSheet = Wkb.Worksheets("MAIN")
Dim ArchiveSheet As Worksheet
Set ArchiveSheet = Wkb.Worksheets("ARCHIVE")
如果我们将这两个 1A 和 2A 结合起来,我们可以在同一个工作簿中引用不同的工作表。
MainSheet.Range(MainSheet.Cells(73, 19), MainSheet.Cells(128, 19)) -> 是工作表“Main”的范围“S73:S128”
对于存档也可以这样做:
ArchiveSheet.Range(ArchiveSheet.Cells(73, 19), ArchiveSheet.Cells(128, 19)) -> 是工作表“存档”的范围“S73:S128”
当我们想要跨工作表复制和粘贴时,此方法很有用。
最后一行可以重新定义为:
Range("A65536").End(xlUp)(2).Select --> Archivelrow = Worksheets("ARCHIVE").Cells(Rows.Count, 2).End(xlUp).Row,其中 lrow 是我们可以用来引用最后一行的变量。
3A - 我们可以循环遍历列中的每个单元格,并且只选择我们感兴趣的单元格,方法是使用“FOR loop”。这将使您的范围动态化。如果添加或删除行,我们只会遍历更多或更少的行。
For i = 6 To 51 'This would tell us, loop from row 6 to 51.
'For each loop, do something
Cells(i,1).Value ' This will take the value for Cell in Column A, at row i. Remember point 1A, where we wrote cells!
Next i
下一步,我们不想复制所有内容。在 A 列中,我们不想复制带有“日期”、“星期一”等标题的单元格。
4A - 如果语句将在这里帮助我们。我们可以设置一个条件(一个 TRUE/FALSE 语句)
If Cells(i,1).Value = "Blue" Or Cells(i,1).Value = "Red" Then
'"Do something" if the current cell in loop has value "Blue" or "Red"
Else
'"Don't do anything" if the current cell in loop don't contain value "Blue" or "Red"
End if
如果我们将这两个 3A 和 4A 结合起来,我们可以循环遍历每个单元格,并且只有在单元格值满足特定条件时才执行。
在你的情况下,我们将:
For i = 6 To Mainlrow 'loop from row 6 to last row in column A and F
' Check if Column F = TOTAL, Check if Column A = DATE, Check if Column B has empty cells, Check Column A for last row that contain word TOTAL
If MainSheet.Cells(i, 6).Value = "TOTAL" Or MainSheet.Cells(i, 1).Value = "DATE" Or _
MainSheet.Cells(i, 2).Value = "" Or MainSheet.Cells(i, 1).Value Like "*TOTAL*" Then
'Do nothing
Else
MainSheet.Range(MainSheet.Cells(i, 1), MainSheet.Cells(i, 11)).Copy _
ArchiveSheet.Range(ArchiveSheet.Cells(Archivelrow, 1), ArchiveSheet.Cells(Archivelrow, 11)) 'Copy range from Sheet "Main" to Sheet "Archive"
Application.CutCopyMode = False 'Remove selection
ArchiveSheet.Range(ArchiveSheet.Cells(Archivelrow, 1), ArchiveSheet.Cells(Archivelrow, 11)).Columns.AutoFit 'Autofit columns
Archivelrow = Archivelrow + 1 'Add one to lastrow
End If
Next i
这将使您的完整代码(更新):
Sub SaveToArchive2()
Dim response As String
response = MsgBox("Are You Sure?", vbYesNo)
If response = vbNo Then
MsgBox ("Goodbye!")
Exit Sub
End If
Dim i As Long
Dim Mainlrow As Long
Dim Archivelrow As Long
Dim Wkb As Workbook
Set Wkb = ThisWorkbook
Dim MainSheet As Worksheet
Set MainSheet = Wkb.Worksheets("MAIN")
Dim ArchiveSheet As Worksheet
Set ArchiveSheet = Wkb.Worksheets("ARCHIVE")
Mainlrow = MainSheet.Cells(Rows.Count, 7).End(xlUp).Row 'take the last row by looking in column G
Archivelrow = ArchiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 'take the last row by looking in column F
For i = 6 To Mainlrow 'loop from row 6 to last row in column A and F
' Check if Column F = TOTAL, Check if Column A = DATE, Check if Column B has empty cells, Check Column A for last row that contain word TOTAL
If MainSheet.Cells(i, 6).Value = "TOTAL" Or MainSheet.Cells(i, 1).Value = "DATE" Or _
MainSheet.Cells(i, 2).Value = "" Or MainSheet.Cells(i, 1).Value Like "*TOTAL*" Then
'Do nothing
Else
With MainSheet.Range(MainSheet.Cells(i, 1), MainSheet.Cells(i, 11))
ArchiveSheet.Range(ArchiveSheet.Cells(Archivelrow, 1), ArchiveSheet.Cells(Archivelrow, 11)).Value = .Value 'Copy range from Sheet "Main" to Sheet "Archive"
End With
Application.CutCopyMode = False 'Remove selection
ArchiveSheet.Range(ArchiveSheet.Cells(Archivelrow, 1), ArchiveSheet.Cells(Archivelrow, 11)).Columns.AutoFit 'Autofit columns
Archivelrow = Archivelrow + 1 'Add one to lastrow
End If
Next i
SendKeys ("{ESC}")
End Sub
您要复制的相同行,您还想清除其中的数据......我们几乎已经完成了上面的代码。我们没有复制,而是替换它并说: Range(xy).ClearContents - 清除此范围的单元格内容。由于您在 A 列中有公式,我们只清除 B 列到 K 列的单元格
所以代码是:
Sub ClearContentMain()
'link this to recycling bin symbol
Dim i As Long
Dim MainClearlrow As Long
Dim Wkb As Workbook
Set Wkb = ThisWorkbook
Dim MainSheet As Worksheet
Set MainSheet = Wkb.Worksheets("MAIN")
Dim ArchiveSheet As Worksheet
Set ArchiveSheet = Wkb.Worksheets("ARCHIVE")
MainClearlrow = MainSheet.Cells(Rows.Count, 7).End(xlUp).Row 'take the last row by looking in column G
For i = 6 To MainClearlrow 'loop from row 6 to last row in column A and F
' Check if Column F = TOTAL, Check if Column A = DATE, Check if Column B has empty cells, Check Column A for last row that contain word TOTAL
If MainSheet.Cells(i, 6).Value = "TOTAL" Or MainSheet.Cells(i, 1).Value = "DATE" Or _
MainSheet.Cells(i, 2).Value = "" Or MainSheet.Cells(i, 1).Value Like "*TOTAL*" Then
'Do nothing
Else
MainSheet.Range(MainSheet.Cells(i, 2), MainSheet.Cells(i, 11)).ClearContents 'clear contents for only values that has values filled in Column A. except headers
End If
Next i
End Sub