vba：使用表格工作并删除重复条件

-1

我想使用VBA从表格中复制多个列（删除重复项并应用一些约束）到另一个工作表中。所有这些如果可能的话，以表格格式。vba：使用表格工作并删除重复条件

我很新的VBA，我不知道这是可能的，但我会需要的是从下面走独特的产品商店组合，使销售> 0

Product Store day  sales 
Apple  A monday  3 
Apple  A tuesday 0 
Apple  A wednesday 4 
Apple  B thursday 7 
Pear  A monday  3 
Pear  C tuesday 0

因此，结果应该是：

Product Store 
Apple  A 
Apple  B 
Pear  A

我已经尝试录制宏，但结果是很长......

顺便说，数据是相当大的，所以我认为这会一行一行不会是一个选项。

来源

2017-07-28 cdom

如果宏的结果是漫长的，但它工作，你不需要解决方案，你只需要改进你的代码。 –

如果你需要帮助，那么你需要提供更多的信息，包括你生成的宏代码，还有什么和什么不适用于宏。 – Thom

试试这个

Sub FilterAndCopy() 

Columns("A:D").Select 'Change to your actual cells that holds the data 
Selection.AutoFilter 
Columns("A:B").Select 'Change to your columns that holds the Products and Store data 
ActiveSheet.Range("$A:$B").RemoveDuplicates Columns:=Array(1, 2), Header :=xlNo 'Change to your columns that holds the Products and Store data 
Range("A1", Cells(Cells(2, 1).End(xlDown).Row, 2)).Select 'Change to your columns that holds the Products and Store data 
Selection.Copy 
Sheets.Add After:=ActiveSheet 
ActiveSheet.Paste 

End Sub

来源

2017-07-28 13:59:33

下面的代码应该有所帮助：

Option Explicit 

Sub Demo() 
    Application.ScreenUpdating = False    'stop screen flickering 
    Application.Calculation = xlCalculationManual 'prevent calculation while execution 

    Dim i As Long, lastrow As Long 
    Dim dict As Object 
    Dim ws As Worksheet 

    Set dict = CreateObject("Scripting.Dictionary") 
    Set ws = ThisWorkbook.Worksheets("Sheet1") 'change Sheet1 to your worksheet 

    With ws 
     lastrow = .Range("A" & .Rows.Count).End(xlUp).Row 'get last row with data from Column A 

     'get unique records for product and store combined together 
     For i = 2 To lastrow 
      If .Cells(i, 4).Value <> 0 Then 'consider product only if sales is not 0 
       dict(.Cells(i, 1).Value & "|" & .Cells(i, 2).Value) = dict(.Cells(i, 1).Value & "|" & .Cells(i, 2).Value) 
      End If 
     Next 

     With .Range("F2").Resize(dict.Count) 'unique product and store will be displayed from cell F2 
      .Value = Application.Transpose(dict.Keys) 
      .TextToColumns Destination:=.Cells, DataType:=xlDelimited, Other:=True, OtherChar:="|" 
      .Offset(, 2).Resize(dict.Count).Value = Application.Transpose(dict.Items) 
     End With 
    End With 

    Application.ScreenUpdating = True 
    Application.Calculation = xlCalculationAutomatic 
End Sub

输出将是如下：

来源

2017-07-28 14:48:22 Mrig

@cdom - 这有帮助吗？ – Mrig

vba：使用表格工作并删除重复条件

回答

相关问题