Finding & filling in other Excel sheets based on c

2019-07-22 17:16发布

I have a workbook with four worksheets: Overview, apple, banana and pear. In the sheet overview I have a 3x3 table:

        In      Out      Extra
apple   
banana  
pear    

Cell H5 in Overview contains a date of 2019, which can be selected via a drop-down menu

In each of the apple/banana/pear sheets, I have a 365x3 table:

               In      Out        Extra
1-1-2019
2-1-2019
3-1-2019
.
.
.
31-12-2019  

I would like to run a macro so that the In, Out and Extra values from the Overview sheet are filled in the correct worksheet and behind the correct date in that worksheet.

The goal would be that people fill in the overview sheet (In, Out and Extra values as well as a date), they run the macro, and data is automatically stored in the right cell in the right worksheet.

This is a relatively easy example, the actual workbook for which I need this macro has more that 70 "fruits".

I know the code below doesn't work, but I'll hope to show my way of thinking

Sub export()

Dim ws As Worksheet             'worksheet
    Dim currentdate As Date         'datum
    Dim fruit As String             'Fruit

    Worksheets("Overview").Activate                 'activate worksheet Overview
    currentdate = ActiveSheet.Cells(H5)             'select date value
fruit = Overview.Range(“C6, C8”)                'select range of the fruits


    For Each ws In Worksheets                           'loop over every worksheet except the Overview sheet
        If ws.Name = fruit Then                         'crossreference name worksheet with fruit in Overview sheet
            ws.Activate                                 'activating the selected worksheet
            If ws.Range("A1:A365") = currentdate Then   'looking for the correct date in the selcted worksheet
                fruit = ws.Name
    Next ws

    End Sub

标签: excel vba
1条回答
倾城 Initia
2楼-- · 2019-07-22 17:32

Vba solution for this:

For this solution to work properly, you should make the sheets APPLE, BANANA and PEAR share same structure. In my example, all this 3 sheets have in column A the date, column B is IN, column C is OUT and column D is EXTRA

Also, in OVERVIEW sheet, make sure the terms APPLE, BANANA and PEAR are exactly equal to names of each sheet (this means no extra spaces, blanks or different chars).

And OVERVIEW must be the active sheet.

enter image description here

My button IMPORT is linked to this code to import data. I want to import data from 17/05/2019 (the yellow rows)

Sub IMPORT_DATA()
Application.ScreenUpdating = False
Range("B2:D4").Clear

Dim i As Long
Dim TargetRow As Long
Dim TargetSheet As String
Dim TargetDate As Date

TargetDate = Range("B6").Value

For i = 2 To Range("A" & Rows.Count).End(xlUp).Row Step 1 'i=2 because dats in OVERVIEW stars at row 2, and Column A
    TargetSheet = Range("A" & i).Value

    'first, we make sure the date from B6 exists in the target worksheet counting
    With Application.WorksheetFunction
        If .CountIf(ThisWorkbook.Worksheets(TargetSheet).Range("A:A"), TargetDate) > 0 Then
            TargetRow = .Match(CDbl(TargetDate), ThisWorkbook.Worksheets(TargetSheet).Range("A:A"), 0)
            Range("B" & i).Value = ThisWorkbook.Worksheets(TargetSheet).Range("B" & TargetRow).Value 'IN value
            Range("C" & i).Value = ThisWorkbook.Worksheets(TargetSheet).Range("C" & TargetRow).Value 'IN value
            Range("D" & i).Value = ThisWorkbook.Worksheets(TargetSheet).Range("D" & TargetRow).Value 'IN value
        End If
    End With
Next i
Application.ScreenUpdating = True
End sub

And after executing this code I get in OVERVIEW:

enter image description here

Now I want to export some values to data, and I use this code:

Sub EXPORT_DATA()
Application.ScreenUpdating = False

Dim i As Long
Dim TargetRow As Long
Dim TargetSheet As String
Dim TargetDate As Date

TargetDate = Range("B6").Value

For i = 2 To Range("A" & Rows.Count).End(xlUp).Row Step 1 'i=2 because dats in OVERVIEW stars at row 2, and Column A
    TargetSheet = Range("A" & i).Value

    'first, we make sure the date from B6 exists in the target worksheet counting
    With Application.WorksheetFunction
        If .CountIf(ThisWorkbook.Worksheets(TargetSheet).Range("A:A"), TargetDate) > 0 Then
            TargetRow = .Match(CDbl(TargetDate), ThisWorkbook.Worksheets(TargetSheet).Range("A:A"), 0)
            ThisWorkbook.Worksheets(TargetSheet).Range("B" & TargetRow).Value = Range("B" & i).Value 'IN value
            ThisWorkbook.Worksheets(TargetSheet).Range("C" & TargetRow).Value = Range("C" & i).Value 'OUT value
            ThisWorkbook.Worksheets(TargetSheet).Range("D" & TargetRow).Value = Range("D" & i).Value 'EXTRA value
        End If
    End With
Next i

MsgBox "data exported"
Application.ScreenUpdating = True
End Sub

And after executing code, check new data (yellow rows): enter image description here

Hope this helps a litte bit and you can adapt to your needs.

查看更多
登录 后发表回答