0

1 月から 12 月までの毎月のワークシートと、コピーされたデータが保存される Report というワークシートがあります。

Monthsシートには、次のデータがあります

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

私がなんとかしたことは、1つのMonthシートからReportにコピーすることですが、すべてのMonthシートから複数をコピーすることはできず、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

あなたがする必要があるのは、各月のシートをループし、各シートですべてのデータをループして、名前で示された name (fNameコード内) に一致するシートの値を見つけることです。合計2ループ。また、スターターとしてこのリンクを確認してください。ただし、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
于 2013-09-04T19:49:05.630 に答える