尝试展开VBA行对齐代码以对齐所有工作表

Question

我正在使用Excel报表，每个月都会添加一个新工作表。工作表中的每一行都是针对某个员工的，该行中的列是与其相关的数据。每个星期，行可能会有所不同，名称被添加和删除。

我写了下面的VBA模块来对齐2个工作表的行，根据需要添加空白行，但我需要找出一种方法来扩展它，以便根据需要将12个工作表与名称之间的多个空格对齐。我不知道该怎么做，有什么建议吗？

Option Explicit 

Sub Align() 
Dim n As Long, a As Range, c As Range, x As Long 
n = Cells.SpecialCells(11).Row 
Set a = Worksheets("Jan").Range("A6:A200"): Set c = Worksheets("Feb").Range("A6:A200") 
a(n + 1) = Chr(255): c(n + 1) = Chr(255) 
a.Sort a(1), 1, Header:=xlNo 
c.Sort c(1), 1, Header:=xlNo 
Do 
x = x + 1 
If a(x) > c(x) Then 
    a(x).EntireRow.Insert xlShiftDown 
ElseIf a(x) < c(x) Then 
    c(x).EntireRow.Insert xlShiftDown 
End If 
If x > 10^4 Then Exit Do 
Loop Until a(x) = Chr(255) And c(x) = Chr(255) 
a(x).ClearContents: c(x).ClearContents 
End Sub 

Answer 1

我不相信你的现有代码的任何简单的重排将满足您的需求。我也相信这是一个太大的问题，期望任何人为你制作一个完整的宏。

下面我概述了我将采取的方法来解决您的问题。我建议你尝试依次解决每个问题。我给出的代码都没有经过测试，所以我怀疑它没有错误。调试我的代码应该可以帮助你理解它。如果遇到困难，您可以回答我的问题。但是，最好尝试构造一个包含你无法工作的代码的新问题。与单一的问题问题，我相信你会得到帮助之快，超过等着我去登录。

我希望这有助于。

第1期 - 识别12个工作表

如果工作簿中只包含12个工作表“一月”，“二月” ......“月”，那么很容易：工作表1到12。如果他们的顺序错误，这并不重要。

如果工作簿包含其他工作表时工作簿的前几个工作表那么这将是几乎一样简单：N至N + 11。

如果其他工作表，月工作表糊涂，你将有访问，然后使用这样的方法：

Dim InxMonth As Long 
Dim InxWsht As Long 
Dim WshtMonthName() As Variant 

WshtMonthName = Array("Jan", "Feb", ... "Dec) 

For InxMonth = 0 to 11 
    InxWsht = WshtMonthName(InxMonth) 

    With Worksheets(InxWsht) 
    ::::::: 
    End with 
Next 

这可能是最好的情况下，仍要使用这种方法，用户增加了一个新的工作表。无论其他工作表可能存在，此技术都可以工作。

第2期 - 获取排序的名字

您需要在含有出现在任何工作表中每个名字的字母顺序列表的列表。我可以想到一些方法。我被教导：让代码工作，然后让它更快，更顺畅或者无论如何。我选择了一种我认为易于实施的方法。其他方法会更快执行，但它并没有听起来觉得你会经常执行的代码，只有12工作表。您花费数小时来调试复杂的代码，将剃几秒钟关运行时间是没有很好的利用你的时间。

问题3 - 排序工作表

你的代码进行排序一个工作表。您需要将该代码放在您为每个月份工作表执行的循环中。

第4期 - 创建名称

的列表这种做法是不是很优雅，我能想到的更快的方法。不过，我认为很容易理解这段代码在做什么。

我已经将NameList初始化为200个条目，因为您的代码似乎假定雇员少于200人。但是，如果需要，代码会放大数组。

Dim InxNameCrntMax as Long 
Dim InxMonth As Long 
Dim InxWsht As Long 
Dim NameList() As String 
Dim NextLowestName As String 
Dim RowCrnt As Long 
Dim WshtRowCrnt() As Long 

ReDim NameList(6 to 200) ' 6 is first data row 
InxNameCrntMax = 0 

ReDim WshtRowCrnt(0 To 11) 
' For each worksheet set the current row to the first data row 
For InxMonth = 0 to 11 
    WshtRowCrnt(InxMonth) = 6 
Next 

Do While True 
    ' Loop until every name in every worksheet has been added to NameList 

    NextLowestName = "~" ' Greater than any real name  

    ' Examine the next row in each worksheet and find the lowest name 
    For InxMonth = 0 To 11 
    With Worksheets(WshtMonthName(InxMonth)) 
     RowCrnt = WshtRowCrnt(InxMonth) ' Get next row for current worksheet 
     If .Cells(RowCrnt, "A") <> "" Then 
     ' Not all names from current worksheet added to NameList 
     If NextLowestName > .Cells(RowCrnt, "A") Then 
      ' This name comes before previous next lowest name 
      NextLowestName = .Cells(RowCrnt, "A") 
     End If 
     End If 
    End With 
    Next   

    If NextLowestName = "~" Then 
    ' All names from all worksheets added to NameList 
    Exit Do 
    End If 

    ' Add NextLowestName to NameList 
    InxNameCrntMax = InxNameCrntMax + 1 
    If InxNameCrntMax > UBound(NameList) Then 
    ' NameList is full so enlarge it 
    ReDim Preserve NameList(6 To UBound(NameList) + 100) 
    End If 
    NameList(InxNameCrntMax) = NextLowestName 

    ' Step the current row for every worksheet containing NextLowestName 
    For InxMonth = 0 To 11 
    With Worksheets(WshtMonthName(InxMonth)) 
     RowCrnt = WshtRowCrnt(InxWsht) ' Get next row for current worksheet 
     If .Cells(RowCrnt, "A") = NextLowestName Then 
     WshtRowCrnt(InxWsht) = RowCrnt + 1 
     End If 
    End With 
    Next 

Loop 

问题5 - 使用NameList中

我初始化的NameList大小(6 To 200)虽然它可能已被放大，因此现在可能是(6 To 300)或(6 To 400)。

VBA是少数几种不要求数组的下界为0的语言之一。值得利用此功能。我从您的代码中了解到，6是工作表中的第一个数据行。这就是为什么我将最低界限定为6。这意味着元素编号与行编号匹配。

InxNameCrntMax是在名字列表的最后使用的条目，所以我们有类似：

NameList(6) = "Aardvark, Mary" 
NameList(7) = "Antelope, John" 
NameList(8) = "Bison, Jessica" 
    :::::: 
NameList(InxNameCrntMax) = "Zebra, Andrew" 

因此，如果对工作表（“扬”）没有玛土豚，第6行应该是空的。如果有John Antelope，他的数据属于第7行。

在您的代码中，您使用InsertRow来插入空白行。我真的不喜欢更新工作表原位，因为如果你搞砸了，你必须从备份副本重新加载数据。

我宁愿从Jan创建工作表“JanNew”，从“Feb”创建工作表“FebNew”等等。当所有这些新工作表都被创建后，我会将“Jan”重命名为“JanOld”等等。那么我会将“JanNew”重命名为“Jan”等等。只有当我确信我已经正确地移动了数据时，我才会删除旧的工作表。让你决定做什么