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 。一些严肃的知识落在这里，研究：How to avoid using Select in Excel VBA macros

'...
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中的一个小错误最终会导致你拉扯你的头发也是一种主要的代码味道。

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

1 个答案: