Question

我正在尝试为部分转帐创建年度摘要。基本上，我有12张纸，一年中每个月都有一张，每个条目在L栏中给出了四个特定的“转移理由”之一。我需要能够创建一个工作表，给我一个运行的年份 - 基于每个转移原理的日期摘要。

所以说，例如，我正在查看的转移原理被称为“错误分配” - 我认为需要让摘要页面显示每个行的列GK，其中列L是从所有十二个月“错误分配”片材。

我一直在关注VBA代码并尝试调整一些工作，但我可以使用一些帮助！

编辑：

显然它没有按照我的需要工作，或者我不会在这里工作，但我对VBA知之甚少。我在这里有一些代码正在抓住列L满足条件的条目，但它是

a）复制所有列，我只需要G-K粘贴，

b）将复制的行全部放在摘要选项卡中的一行中，这样我就可以看到数据一瞬间，然后它将覆盖下一行，依此类推，直到最后确定最后一个条目为止找到。

第二次编辑：

所以我有一个现在（大部分）工作的代码，我已将其粘贴到下面并删除了上面的旧代码。

Private Sub CommandButton1_Click()
    Dim WkSht As Worksheet
     Dim r As Integer
     Dim i As Integer
     i = 1
     For Each WkSht In ThisWorkbook.Worksheets
      i = i + 1
             If WkSht.Name <> "Incorrectly Assigned" Then
                     For r = 1 To 1000

                     If WkSht.Range("L" & r).Value = Sheets("Incorrectly Assigned").Range("A1").Value Then
                             WkSht.Range("E:L").Rows(r & ":" & r).Copy
                             Sheets("Incorrectly Assigned").Range("E:L").End(xlUp).Offset(i, 0).PasteSpecial Paste:=xlPasteValues
                     End If
                     Next r
             End If
     Next WkSht
End Sub

现在的问题是它只抓取每个工作表中的最后一个匹配 - 所以说1月有四个匹配的条目，它只粘贴第四个条目，然后下一行它将粘贴2月的最后一个条目等。然后如果11月份有一个匹配的条目，它将从头开始粘贴在第11行，而不是一个接一个地粘贴每个条目。

Answer 1

您不需要VBA - 只需在另一个标签中放弃单元格：

SheetName!CellAddress

使用工作表名称在单元格地址前面，并用感叹号跟随它。

如果您需要VBA，那么我已经错误地理解了您的问题。

编辑：

让我们从问题B开始：

将复制的行全部放在摘要标签
中的一行中

让我们看看用于粘贴值的代码：

Sheets("Summary").Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

在这里，您始终将每个人粘贴在相同的位置，在单元格A65536中，您将其偏移一个。在循环的每次迭代中，值都将在同一位置。将偏移（1）更改为

Offset(0, r)

现在，在每次迭代时，您将粘贴到另一行，因为r将为1,2，...，1000。有关Offset的文档，请参阅MSDN。选择一个以您需要的方式完成粘贴的值。

让我们进入下一个问题：

a）它正在复制所有列

我会在第一部分按照你应该的方式工作时进行编辑。

Answer 2

最好创建一个从＆＃34; CommandButton1＆＃34;中调用的子例程。然后，您可以从多个位置调用该过程。您也可以使用输入参数＆＃39; transferID＆＃39;来概括它。它定义了你想要的摘要。

Private Sub CommandButton1_Click()
    Call PrintSummary("Incorrectly Assigned")
End Sub

可能需要进行一些调整才能达到你想要的效果，但是这应该会给你一些启发的想法：

Sub PrintSummary(transferID As String)

    Dim ws      As Excel.Worksheet
    Dim wso     As Excel.Worksheet
    Dim lrow    As Long
    Dim rng     As Excel.Range
    Dim rngo    As Excel.Range
    Dim cell    As Excel.Range
    Dim colH    As Variant
    Dim i       As Integer

    '// Define columns for output
    colH = Array("G", "H", "I", "J", "K")

    '// Check for summary sheet (for output)
    On Error Resume Next
    Set wso = ThisWorkbook.Worksheets("Summary")
    On Error GoTo 0

    If wso Is Nothing Then

        '// Summary worksheet does not exist :/
        Exit Sub

    Else '// format worksheet for output

        '// for example...
        wso.Cells.Delete Shift:=xlUp
        Set rngo = wso.Range("A1") '// define output start
        Set wso = Nothing

    End If

    '// Loop through worksheets
    For Each ws In ThisWorkbook.Worksheets

        '// Check for valid worksheet name
        Select Case VBA.UCase(ws.Name)

            Case "JAN", "FEB" '// and so forth...

                Set rng = ws.Range("L1")
                Set rng = ws.Range(rng, ws.Cells(Rows.Count, rng.Column).End(xlUp))

                For Each cell In rng

                    If (VBA.UCase(cell.Text) = VBA.UCase(transferID)) Then

                        '// Print meta data
                        rngo.Offset(lrow, 0).Value = ws.Name
                        rngo.Offset(lrow, 1).Value = transferID

                        '// Print values
                        For i = 0 To UBound(colH)

                            rngo.Offset(lrow, i + 2).Value = ws.Cells(cell.Row, VBA.CStr(colH(i))).Value

                        Next i

                        '// Update counter
                        lrow = lrow + 1

                    End If

                Next cell

            Case Else

                '// Not a month? do nothing

        End Select

    Next ws

End Sub

需要将来自多个Excel工作表的数据汇总到一个摘要页面中

2 个答案: