0

我有一个从一月到十二月的每个月的工作表和一个名为报告的工作表，复制的数据在哪里

在月表中，我有以下数据

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
4

2 回答 2

0

您需要做的是遍历您的每个月表，并在每张表上循环所有数据以在该表上查找与您的名称指示的名称（在您的代码中）匹配的值。总共两个循环。另外，请查看此链接作为入门，但在编写 VBA 代码时也应避免选择和复制。fName

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

'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
于 2013-09-04T19:49:05.630 回答
0

我花了一段时间才得到一个新代码，它运行得更快，并且完全可以完成我需要的工作。

我有以下工作表数据，一月，二月，三月，四月，五月，六月，七月，八月，九月，十月，十一月，十二月，总结

以下代码搜索特定文本，并将除 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))
于 2013-09-15T21:27:55.157 回答