Question

我有一个从1月到12月的每个月的工作表和一个名为Report的工作表，其中复制的数据为

在月份表中，我有以下数据

ID     NAME     # DAYS OF VACATION
1      GEORGE   3
2      MARY     5

每月工作表具有相同的名称，但名称未绑定到相同的ID 我想在摘要表中做什么

ID     NAME     # DAYS OF VACATION     MONTH
1      GEORGE   3                      JAN
2      GEORGE   2                      FEB
SUM    GEORGE   5                      YEAR

我设法做的是从一个月份表复制到报告，但我不能从所有月份表中复制多个，我不知道如何处理SUM部分。有什么想法吗？

Sub SearchForString()

    Dim LSearchRow As Integer
    Dim LCopyToRow As Integer

    On Error GoTo Err_Execute

    'Start search in row 2
    LSearchRow = 2
    'Start copying data to row 2 in Sheet2 (row counter variable)
    LCopyToRow = 2

    fname = InputBox("Enter Name", "Enter Data")
    If fname = "" Then
        While fname = ""
            MsgBox ("Enter Name")
            fname = InputBox("Enter Name", "Enter Data")
        Wend
    End If

    While Len(Range("A" & CStr(LSearchRow)).Value) > 0

        'If value in column E = "Mail Box", copy entire row to Sheet2
        If Sheets("JAN").Range("B" & CStr(LSearchRow)).Value = fname Then

            'Select row in Sheet1 to copy
            Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
            Selection.Copy

            'Paste row into Sheet2 in next row
            Sheets("REPORT").Select

            Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste
            'AddWatermark ("JAN")

             'Move counter to next row
             LCopyToRow = LCopyToRow + 1
        End If

        'Go back to Sheet1 to continue searching
        Sheets("REPORT").Select

         LSearchRow = LSearchRow + 1
    Wend

    'Position on cell A3
    Application.CutCopyMode = False
    Range("A3").Select

    MsgBox "COPY DONE"

Exit Sub
Err_Execute:
   MsgBox "ERROR"
End Sub

Answer 1

您需要做的是通过每个月份表循环，并在每张工作表上循环通过所有数据来查找该工作表上的值符合您姓名的名称（代码中为fName）。共有两个循环。另外，请查看this link作为入门者，但在编写VBA代码时也应避免选择和复制。

您正在寻找的基本代码（做出一些假设）将是以下

'Assuming Jan is the first sheet and Dec is the 12th sheet in the workbook

lCopyToRow = 2
for i = 1 to 12
    lSearchRow = 2
    do while Len(Sheets(i).Cells(lSearchRow,1).value) > 0
        If  Sheets(i).Cells(lSearchRow,2).value = fName then
            Sheets("Summary").range(Sheets("Summary").Cells(lCopyToRow,1), _
                    Sheets("Summary").Cells(lCopyToRow,3)) = _
                           Range(Sheets(i).Cells(lSearchRow,1), _
                                       Sheets(i).Cells(lSearchRow,3)).value
            lCopyToRow = lCopyToRow + 1
        End If
        lSearchRow = lSearchRow + 1
    Loop
Next i

Answer 2

花了我一段时间，但我最终得到了一个新代码，它运行得更快，完全符合我的需要。

我有以下工作表DATA，JAN，FEB，MAR，APR，MAY，JUN，JUL，AUG，SEP，OCT，NOV，DEC，SUMMARY

以下代码搜索特定文本，并将除DATA和SUMMARY之外的每个工作表中的行复制到SUMMARY工作表。最后，我总结了一些整数来得到我想要的结果。感谢大家在我的问题上花了一些时间。

   Sheets("SUMMARY").Cells.Clear 
Dim rFind As Range, fname As String, sAddr As String, ws As Worksheet 

fname = InputBox("Input Name", "Input Name") 
If fname = "" Then 
    While fname = "" 
        MsgBox ("Fatal Error") 
        fname = InputBox("Input Name", "Input Name") 
    Wend 
End If 


For Each ws In Worksheets 
    If (ws.Name <> "SUMMARY") And (ws.Name <> "DATA") Then 

        With ws.UsedRange.Range("B2", "AK36") 

            Set rFind = .Find(What:=fname, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) 
            If Not rFind Is Nothing Then 
                sAddr = rFind.Address 
                Do 
                    rFind.EntireRow.Copy Sheets("SUMMARY").Range("A" & Rows.Count).End(xlUp)(2) 
                    Set rFind = .FindNext(rFind) 
                Loop While rFind.Address <> sAddr 
                sAddr = "" 
            End If 
        End With 
    End If 
Next ws 

Dim LR As Long 
With Sheets("SUMMARY") 
    LR = .Range("G" & Rows.Count).End(xlUp).Row 
    .Range("G" & LR + 1).Value = WorksheetFunction.Sum(.Range("G1:G" & LR))

从多个表格复制行和总和值

2 个答案: