Question

我是宏的新手，但有一些基本的想法，它是如何工作的，或者能够编写小的VBA代码。

当我使用下面的宏实际将不同工作表中的数据复制到一个名为Import

的工作表时，是否可以避免超过1张

VBA代码

Option Explicit
Public Sub CombineDataFromAllSheets()

Dim wksSrc As Worksheet, wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long
Dim Strname As String

'Notes: "Src" is short for "Source", "Dst" is short for "Destination"

'Set references up-front
Set wksDst = ThisWorkbook.Worksheets("Import")
lngDstLastRow = LastOccupiedRowNum(wksDst) '<~ defined below (and in Toolbelt)!
lngLastCol = LastOccupiedColNum(wksDst) '<~ defined below (and in Toolbelt)!

'Set the initial destination range
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)

'Loop through all sheets
For Each wksSrc In ThisWorkbook.Worksheets

    'Make sure we skip the "Import" destination sheet!
    Strname = UCase(wksSrc.Name)
    If Strname <> "Import" And _
    Strname <> "Import2" Then

        'Identify the last occupied row on this sheet
        lngSrcLastRow = LastOccupiedRowNum(wksSrc)

        'Store the source data then copy it to the destination range
        With wksSrc
            Set rngSrc = .Range(.Cells(2, 1), .Cells(lngSrcLastRow, lngLastCol))
            rngSrc.Copy Destination:=rngDst
        End With

        'Redefine the destination range now that new data has been added
        lngDstLastRow = LastOccupiedRowNum(wksDst)
        Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)

    End If

Next wksSrc
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last row
'OUTPUT      : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Row
        End With
    Else
        lng = 1
    End If
    LastOccupiedRowNum = lng
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last column
'OUTPUT      : Long, the last occupied column
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByColumns, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Column
        End With
    Else
        lng = 1
    End If
    LastOccupiedColNum = lng
End Function

例如我有一张excel的5张纸，它们是

Sheet 1中。控制表（更像是仪表板/ UI）
Sheet2中。导入（需要复制数据的地方）
表Sheet 3。比较（无需复制本表中的数据）
Sheet4。 CSV文件1（所有可用数据将复制到IMPORT 片）
Sheet5。 CSV文件2（所有可用数据将复制到IMPORT 表）

现在当用户运行查询时，只有来自工作表5和工作表6的数据被复制到工作表2（导入）

我用过

Strname = UCase(wksSrc.Name)
If Strname <> "Import" And _
Strname <> "Comparison" And _ 
Strname <> "Control Sheet" Then

但这实际上不起作用，只是复制所有5张纸上的所有内容。

请帮助我。

先谢谢

Answer 1

Select Case语句非常适合处理对值的多重比较。

    Select Case UCase(wksSrc.Name)
        Case UCase("Import"), UCase("Comparison"), UCase("Control Sheet")

        Case Else

    End Select

我在这里使用Filter进行文字比较。

我更喜欢将Source范围传递给辅助函数。这使调试变得非常容易。

Public Sub CombineDataFromAllSheets2()
    Dim LastUsedCell As Range, ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        With ws
            If Filter(Array("Import", "Comparison", "Control Sheet"), .Name, True, vbTextCompare) = -1 Then

                Set LastUsedCell = getLastUsedCell(ws)
                If LastUsedCell Is Nothing Then
                    MsgBox "No Cells Found on Worksheet: " & ws.Name, vbInformation, "Worksheet Skipped"
                Else
                    ImportRange .Range(.Cells(2, 1), LastUsedCell)
                End If

            End If
        End With
    Next
End Sub

Public Sub ImportRange(Source As Range)
    With ThisWorkbook.Worksheets("Import")
        With .Range("A" & .Rows.Count).End(xlUp)
            Source.Copy Destination:=.Offset(1)
        End With
    End With
End Sub

Public Function getLastUsedCell(ws As Worksheet) As Range
    Set getLastUsedCell = ws.Cells.Find(What:="*", After:=ws.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
End Function

我们运行宏时如何避免工作表将多张工作表中的数据合并为一张工作表

1 个答案: