Question

我需要将列C中有空白的列表复制到排序为删除空白的列0中。我需要在代表月份的多张纸上进行此操作（一月，二月，三月，四月...）。我遇到的问题是它使用了：ActiveWorkbook.Worksheets（“ Jan”），因此，如果我执行do循环以获取其他月份（2月，3月...），则它将无法正常工作。

基本上，我要获取的是C列中每个月所有名称的主列表，以提供摘要选项卡，其中列出了各个月份的所有名称。根据运行该文件的月份，该文件将仅包含已发生月份的工作表。

下面是我的代码：

 'First Tab
     Columns("C:C").Select
        Selection.Copy
        Columns("O:O").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
     SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    With ActiveWorkbook.Worksheets("Jan").Sort
        .SetRange Range("O1:O1590")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply

       Range("o:o").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort key1:=Range("o:o", Range("o:o").End(xlDown)), _
order1:=xlAscending, Header:=xlNo

'Add the managers to the next sheet
 Range("O1").Select

    Selection.End(xlUp).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    Range("p1").Select
    ActiveSheet.Paste


     End With

ActiveSheet.Next.Select

'''''''''''''''''''''
'''''''''''''''''''''


Do


Columns("C:C").Select
    Selection.Copy
    Columns("O:O").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    With ActiveWorkbook.Worksheets("Jan").Sort
        .SetRange Range("O1:O1590")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply

       Range("o:o").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort key1:=Range("o:o", Range("o:o").End(xlDown)), _
order1:=xlAscending, Header:=xlNo

'Add the names to the next sheet

 Range("O1").Select

    Selection.End(xlUp).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    Range("p1").Select





   ' Selection.End(xlDown).Select
   ' Selection.End(xlUp).Select
    ActiveSheet.Paste

    ActiveSheet.Previous.Select
    Range("O1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveSheet.Next.Select
   Range("O1").Select
    Selection.End(xlDown).Select
     ActiveCell.Offset(1).Select
    ActiveSheet.Paste

    Selection.End(xlDown).Select
    Selection.End(xlDown).Select

   End With

If ActiveSheet.Next.Name = "Summary" Then
Exit Do

ElseIf ActiveSheet.Index <> Sheets.Count Then
ActiveSheet.Next.Select
Else
Exit Do
End If
Loop
ActiveSheet.Next.Select
Range("A1").Select


    Sheets("Summary").Select
    ActiveSheet.Previous.Select
    Columns("O:O").Select
    Selection.Copy
    ActiveSheet.Next.Select
    ActiveWindow.ScrollColumn = 2
    Columns("AC:AC").Select
    ActiveSheet.Paste
    Range("AC2").Select
    Selection.End(xlUp).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.ScrollColumn = 1
    Range("A3").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    'ActiveSheet.Range("$A$2:$A$43").RemoveDuplicates Columns:=1, Header:=xlYesActiveSheet.Range.Cells("a1").Select


Sheets("Guide").Select
End Sub

Answer 1

您可以使用Format()来获取工作表名称。

下面是一个用于您的目的的示例。您将需要修改代码以使用工作表名称（如String）或工作表对象本身输入来工作。 sName是您贴在上的内容。这里的示例使用“工作表对象参考”。

Option Explicit

Sub ProcessAllMonthsWorksheet()
    Dim iMonth As Integer, iYear As Integer, sName As String
    Dim oWS As Worksheet
    iYear = Year(Date)
    On Error Resume Next
    For iMonth = 1 To 12
        sName = Format(DateSerial(iYear, iMonth, 1), "mmm")
        Debug.Print "sName: " & sName
        Set oWS = ThisWorkbook.Worksheets(sName)
        If Not oWS Is Nothing Then ProcessMonthWorksheet oWS
        Set oWS = Nothing
    Next
End Sub

Private Sub ProcessMonthWorksheet(ByRef WorksheetObject As Worksheet)
    Debug.Print "Processing worksheet """ & WorksheetObject.Name & """"
    With WorksheetObject
        ' do your stuff with the worksheet
    End With
End Sub

VBA在工作簿中的相似工作表上排序，而不使用基于月的命名工作表，该工作表会根据当月的月而变化

1 个答案: