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：使用表格工作並刪除重複條件

回答

相關問題