VBA：从具有未定义条目的多个工作表创建一个主表

Question

请帮助，我迫切需要它，我们将为您提供帮助。

我正在创建一个摘要表，该表将从所有表中引入5列。

这些工作表可能有多余的列，但是我只想将特定的变量从每个工作表中引入到摘要工作表中。 此外，工作表中还将有一个名为里程碑的列，这是非常重要的，所以我只对里程碑不为空的点的5列数据感兴趣。

同样，每个工作表可能具有多个数据点，而与其他工作表的数量无关。

摘要表应包括所有要点（工作表中每个点的所有里程碑和相关数据），并在每个员工填写每张工作表时自动填充。

到目前为止，我有这个功能，但似乎无法正常工作，我对VBA还是很陌生，非常感谢：

Sub MakeSummary()

'J stands for rows in summary2 sheet
'I stands for sheet number

Sheets("SUMMARY2").Select
'Range("A1:D60").Value = ""
J = 4
For I = 4 To Sheets.Count
    A = Sheets(I).Name
        If (Sheets(A).Range("A1").Value = "") Then GoTo 10
        x = 3
            For Each Worksheet In ThisWorkbook.Sheets

                Do Until Cells(x, 1).Value <> ""
                    Range("A" + Format(J)).FormulaR1C1 = "='" + A + "'!R4C1"
                Loop

                ''Do While Cells(x, 1).Value <> ""
                    ''Range("B" + Format(J)).FormulaR1C1 = "='" + A + "'!R4C2"
                ''Loop

                Do Until Cells(x, 1).Value <> ""
                    Range("B" + Format(J)).FormulaR1C1 = "='" + A + "'!R4C3"
                Loop

                Do Until Cells(x, 1).Value <> ""
                    Range("C" + Format(J)).FormulaR1C1 = "='" + A + "'!R4C4"
                Loop
            Next Worksheet
    J = J + 1
10:
    Next I

End Sub

Answer 1

编辑：稍微调整了设计（从每个源工作表中删除了扇区列，因为该信息可从Sheet.Name ），尝试一下：

Option Explicit
Sub CombineDataSheets()

Dim Summary As Worksheet, Sheet As Worksheet
Dim MonthCol As Long, LastSummaryRow As Long, _
    LastRow As Long, Index As Long
Dim Source As Range, Target As Range

'set references up-front
Set Summary = ThisWorkbook.Worksheets("SUMMARY2")
MonthCol = 1
LastSummaryRow = FindLastRow(Summary)

'loop through sheets and write info back to summary
For Each Sheet In ThisWorkbook.Worksheets
    'write out all data except sector
    If Sheet.Name <> "SUMMARY2" And Sheet.Name <> "Summary" _
        And Sheet.Name <> "Milestone Types" Then
        With Sheet
            If .Cells(4, MonthCol) <> "" Then
                LastRow = .Cells(.Rows.Count, MonthCol).End(xlUp).Row
            Else
                LastRow = 4
            End If
            Set Source = .Range(.Cells(4, MonthCol), .Cells(LastRow, 7))
        End With
        With Summary
            Set Target = .Range(.Cells(LastSummaryRow + 1, MonthCol + 1), _
                .Cells(LastSummaryRow + 1 + LastRow, 7))
            Source.Copy Target
            'write out sector data
            Index = FindLastRow(Summary)
            While .Cells(Index, 1) = ""
                .Cells(Index, 1) = Sheet.Name
                Index = Index - 1
            Wend
        End With
        LastSummaryRow = FindLastRow(Summary)
    End If
Next Sheet

End Sub

'handy function to identify the last row in a worksheet
Public Function FindLastRow(flrSheet As Worksheet) As Long
    If Application.WorksheetFunction.CountA(flrSheet.Cells) <> 0 Then
        FindLastRow = flrSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Else
        FindLastRow = 1
    End If
End Function

原始回复：以下是一些出发点：

声明您的变量，并使用 Option Explicit 捕获拼写错误。

Option Explicit '<~ will save your bacon
Sub MakeSummary()

'declare variables, here's a start:
Dim J As Long, I As Long, x As Long
Dim Sheet As Worksheet
'...
'start doing stuff

避免 .Select 时即可。 这里有一些重要的知识，请继续学习： 如何避免在Excel VBA宏中使用Select

'...
Dim Summary As Worksheet
Set Summary = ThisWorkbook.Worksheets("SUMMARY2")
'...
'you can now operate on the Summary sheet by referencing it directly.
'for example:
Summary.Cells(x, 5) = "Some Text"

寻找重复，因为它通常是重构的机会。 您在这里有三个Do...While循环都在做相同的事情，因此可以组合您的逻辑：

'...
Do Unit Cells(x, 1).Value <> ""
   Range("A" + Format(J)).FormulaR1C1 = "='" + A + "'!R4C1"
   Range("B" + Format(J)).FormulaR1C1 = "='" + A + "'!R4C3"
   Range("C" + Format(J)).FormulaR1C1 = "='" + A + "'!R4C4"
Loop
'...

除非绝对必要，否则请 不要使用 GoTo 。 GoTo一个小错误最终将导致您拔头发，这也是主要的代码味道。