Question

首先让我开始......我通常不使用excel，所以这里有新手。

表1是这样布局的......

（订购日期），（数量），（说明），（供应商），（原因）

在表2中，我希望能够从供应商列中提取特定供应商，并将有关它的所有列移植到表2。

所以我可以快速查看sheet2，sheet3等...并查看已经订购并与特定供应商共同使用的内容，并帮助我跟踪每个供应商的订购情况。

提前感谢您的回复。

Answer 1

这是一个宏观解决方案：

    Sub create_sheets_with_data()
        'assumes that "main" sheet contains data with a header row
        'needs to be run from "main" sheet

        'delete all sheets whose name contains "viewport"
        Application.DisplayAlerts = False
        For i = Sheets.Count To 1 Step -1
            If InStr(1, Sheets(i).Name, "viewport", vbTextCompare) > 0 Then Sheets(i).Delete
        Next i
        Application.DisplayAlerts = True

        'get last row
        last_row = Cells.SpecialCells(xlCellTypeLastCell).Row

        'sort by vendor
        Rows("1:1").Select
        ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("main").Sort.SortFields.Add Key:=Range("D2:D" & last_row) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("main").Sort
            .SetRange Range("A1:E" & last_row)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        'for each vendor in "main" sheet, create a viewport to the data
        Dim r As Long, dest_row As Long
        r = 2
        last_vendor = ""
        cur_vendor = Range("d" & r).Value
        viewport_num = 0
        Do While Not cur_vendor = ""
            If cur_vendor = last_vendor Then
                'add current line to current viewport tab
                copy_line r, dest_row
                dest_row = dest_row + 1
            Else
                'create new viewport, copy over header, and copy current line
                If viewport_num > 0 Then Cells.EntireColumn.AutoFit
                viewport_num = viewport_num + 1
                Sheets.Add After:=Sheets(Sheets.Count)
                Sheets(Sheets.Count).Name = "viewport " & viewport_num
                copy_line 1, 1 'header
                copy_line r, 2 'current line
                dest_row = 3
            End If
            r = r + 1
            last_vendor = cur_vendor
            cur_vendor = Sheets("main").Range("d" & r).Value
        Loop
        If viewport_num > 0 Then Cells.EntireColumn.AutoFit

        Sheets("main").Activate
    End Sub

    Sub copy_line(src_r As Long, dest_r As Long)
        'copies line from "main" sheet to active sheet
        Sheets("main").Rows(src_r & ":" & src_r).Copy
        Range("a" & dest_r).Select
        ActiveSheet.Paste
    End Sub

我使用的是宏解决方案，而不是公式，因为在我看来，您可能会在未来的某个时刻将新的供应商添加到数据中。为了避免手动制作纸张，我避免使用公式。

请注意，此解决方案将使主页按供应商排序。

我希望有帮助〜

将目标信息从一个工作表移植到另一个工作表

1 个答案: