Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/25.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Vba 基于值筛选列并从相应的值复制该值_Vba_Excel - Fatal编程技术网

Vba 基于值筛选列并从相应的值复制该值

Vba 基于值筛选列并从相应的值复制该值,vba,excel,Vba,Excel,这是我的excel文档的屏幕截图。 我希望基于值应用过滤器:墨西哥Bimbo、加拿大Bimbo,并将值(来自A列和B列)复制并粘贴到新的工作表中。我希望在为客户端构建模板时使用宏来完成此操作。有办法做到这一点吗?我知道可以手动使用过滤器手动完成,但我希望它基于宏 我希望输出如下: 我用了录制宏,这是我得到的宏 Sub RecordedMacro() ' ' RecordedMacro Macro ' ' Keyboard Shortcut: Ctrl+l ' Sheets("re

这是我的excel文档的屏幕截图。

我希望基于值应用过滤器:墨西哥Bimbo、加拿大Bimbo,并将值(来自A列和B列)复制并粘贴到新的工作表中。我希望在为客户端构建模板时使用宏来完成此操作。有办法做到这一点吗?我知道可以手动使用过滤器手动完成,但我希望它基于宏

我希望输出如下:

我用了录制宏,这是我得到的宏

Sub RecordedMacro()
'

' RecordedMacro Macro
'

' Keyboard Shortcut: Ctrl+l
'
    Sheets("report").Select
    Range("C1").Select

    ActiveSheet.Range("$A$1:$S$1001").AutoFilter Field:=3, Criteria1:="Barcel"
    Columns("L:L").Select

    Selection.Copy

    Sheets("SkuRounds").Select

    Columns("S:S").Select

    ActiveSheet.Paste
    Sheets("report").Select

    ActiveSheet.Range("$A$1:$S$1001").AutoFilter Field:=3, Criteria1:= _
        "Bimbo Canada"
    Columns("L:L").Select

    Application.CutCopyMode = False
    Selection.Copy
    Sheets("SkuRounds").Select
    Columns("T:T").Select
    ActiveSheet.Paste
    Sheets("report").Select
    ActiveSheet.Range("$A$1:$S$1001").AutoFilter Field:=3, Criteria1:= _
        "Bimbo Latin Centro"
    Columns("L:L").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("SkuRounds").Select
    Columns("U:U").Select
    ActiveSheet.Paste
    Sheets("report").Select
    ActiveSheet.Range("$A$1:$S$1001").AutoFilter Field:=3, Criteria1:= _
        "Bimbo México"
    Columns("L:L").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("SkuRounds").Select
    Columns("V:V").Select
    ActiveSheet.Paste
End Sub
我正在将数据从工作表(报表)复制到工作表(报表)

尝试一下:

Sub tgr()

    Dim wb As Workbook
    Dim wsReport As Worksheet
    Dim wsSKU As Worksheet
    Dim dictUnqCompanies As Object
    Dim aCompanies As Variant
    Dim vCompany As Variant
    Dim lDestCol As Long

    Set wb = ActiveWorkbook
    Set wsReport = wb.Sheets("report")
    Set wsSKU = wb.Sheets("skurounds")
    Set dictUnqCompanies = CreateObject("Scripting.Dictionary")
    lDestCol = wsSKU.Columns("S").Column

    'Clear previous results
    wsSKU.Range(wsSKU.Cells(1, "S"), wsSKU.Cells(1, wsSKU.Columns.Count)).EntireColumn.Clear

    With wsReport.Range("C2", wsReport.Cells(wsReport.Rows.Count, "C").End(xlUp))
        If .Row < 2 Then Exit Sub   'No data
        If .Rows.Count = 1 Then
            'Only 1 row of data
            wsSKU.Cells(1, lDestCol).Value = .Value
            .Parent.Cells(.Row, "L").Copy wsSKU.Cells(2, lDestCol)
            Exit Sub
        Else
            aCompanies = .Value
        End If
    End With

    For Each vCompany In aCompanies
        If Not dictUnqCompanies.exists(vCompany) Then
            dictUnqCompanies.Add vCompany, vCompany
            With wsReport.Range("C1", wsReport.Cells(wsReport.Rows.Count, "C").End(xlUp))
                .AutoFilter 1, vCompany
                wsSKU.Cells(1, lDestCol).Value = vCompany
                Intersect(.Parent.Columns("L"), .Offset(1).EntireRow).Copy wsSKU.Cells(2, lDestCol)
                lDestCol = lDestCol + 1
                .AutoFilter
            End With
        End If
    Next vCompany

End Sub
Sub-tgr()
将wb设置为工作簿
以工作表形式提交报告
将wsSKU设置为工作表
Dim dictUnqCompanies作为对象
Dim公司作为变体
Dim vCompany作为变型
暗淡的颜色和长的颜色一样
设置wb=ActiveWorkbook
设置wsReport=wb.Sheets(“报告”)
设置wsSKU=wb.Sheets(“SKU”)
Set dictUnqCompanies=CreateObject(“Scripting.Dictionary”)
lDestCol=wsSKU.Columns(“S”).Column
"明确以往的结果,
wsSKU.Range(wsSKU.Cells(1,“S”)、wsSKU.Cells(1,wsSKU.Columns.Count)).entireclumn.Clear
使用wsReport.Range(“C2”,wsReport.Cells(wsReport.Rows.Count,“C”).End(xlUp))
如果.Row<2,则退出Sub“无数据”
如果.Rows.Count=1,则
'只有一行数据
wsSKU.Cells(1,lDestCol).Value=.Value
.Parent.Cells(.Row,“L”)。复制wsSKU.Cells(2,lDestCol)
出口接头
其他的
a公司=.Value
如果结束
以
对于A公司中的每个V公司
如果不存在dictUnqCompanies.exists(vCompany),则
命令公司。添加vCompany,vCompany
使用wsReport.Range(“C1”,wsReport.Cells(wsReport.Rows.Count,“C”).End(xlUp))
.自动筛选1,vCompany
wsSKU.Cells(1,lDestCol).Value=vCompany
相交(.Parent.Columns(“L”),.Offset(1).EntireRow)。复制wsSKU.Cells(2,lDestCol)
lDestCol=lDestCol+1
.自动过滤器
以
如果结束
下一家公司
端接头

打开宏录制,然后手动执行操作以获得所需结果,然后停止录制。编辑创建的宏以满足您的需要(通常删除所有.select/.activates并泛化过滤器以使用变量或循环,而不是硬编码的值)。@tigeravatar感谢您的帮助。录制完宏后,我尝试从粘贴的工作表运行宏,它会给我带来错误,但是当我从粘贴的工作表运行宏时,我复制它工作正常,问题是我想从粘贴的工作表运行宏。您需要将工作表声明为变量,并相应地进行设置。有关如何执行此操作的示例,请参见。此外,对于编辑宏,我对宏非常陌生,编辑循环宏需要一段时间。还有其他可能的方法吗?或者这是最好的方法?编辑你的问题,将你的代码包括在内,这样我们就可以看到你已经做出了最初的努力,然后你可能会得到答案