根据excel

时间:2016-09-28 19:11:54

标签: excel vba excel-vba

我有数据表,我想在其他表格中获取数据但有条件。例如:

-------------------------------------------------
| Cell A   | Cell B |  Cell C    | Cell D|Cell E |        
|------------------------------------------------|
| Sku      |Order_ID|Customer_ID | Price |Status | 
|------------------------------------------------|
| TW22     |   123  |    1       |221    |   D   |
|------------------------------------------------|
| TS44     |  124   |     2      |221    |   D   |
|------------------------------------------------|
| Ts11-ab  |   33   |     3      |211    |   D   |
|------------------------------------------------|
| Ts11     |   231  |     4      |231    |   D   |
|------------------------------------------------|
| Ts11-ab  |   33   |     3      |211    |   R   |
|------------------------------------------------|
| Ts11     |   231  |     4      |231    |   R   |
|------------------------------------------------|

我在例如上面的表格中有数据,现在我想在我的另一张表格中看到像下面这样的值:

-------------------------------------------------
| Cell A   | Cell B |  Cell C    | Cell D|Cell E |        
|------------------------------------------------|
| Sku      |Order_ID|Customer_ID | Price |Status | 
|------------------------------------------------|
| TW22     |   123  |    1       |221    |   D   |
|------------------------------------------------|
| TS44     |  124   |     2      |221    |   D   |
|------------------------------------------------|
| Ts11-ab  |   33   |     3      |211    |   R   |
|------------------------------------------------|
| Ts11     |   231  |     4      |231    |   R   |
|------------------------------------------------|

我已经尝试过vlookup和其他公式从网上找到,但没有帮助,因为我需要。

更新:如果订单ID在工作表1中有两个状态为“D”和“R”的记录,则它应在工作表2中显示状态为“R”的条目。如果只有一个状态为“的记录” D“,那么它应该显示在表2中的记录。谢谢

3 个答案:

答案 0 :(得分:3)

注意:我自己对VBA很新,所以这很麻烦,但应该有效。

让RawData成为你提到的带有重复项的完整列表的第一张表,如果存在“D”,则将NewData作为第二张表,删除“R”。

Option Explicit

Sub RemoveDuplicates()
Dim i As Integer
i = 3
Worksheets("RawData").Activate
Range("A1:E2").Copy
Worksheets("NewData").Activate
Range("A1").Activate
        ActiveCell.PasteSpecial Paste:=xlPasteValues

Do While Sheets("RawData").Cells(i, 1).Value <> ""
If Sheets("NewData").Range("A:A").Find(Sheets("RawData").Cells(i, 1),         LookAT:=xlWhole) Is Nothing Then
Worksheets("RawData").Activate
Range(Cells(i, 1), Cells(i, 5)).Copy
Worksheets("NewData").Activate
        Range("A1").End(xlDown).Offset(1, 0).Activate
        ActiveCell.PasteSpecial Paste:=xlPasteValues
Else
    Worksheets("RawData").Activate
Range(Cells(i, 1), Cells(i, 5)).Copy
Worksheets("NewData").Activate
Sheets("NewData").Range("A:A").Find(Sheets("RawData").Cells(i, 1),     LookAT:=xlWhole).Activate
        ActiveCell.PasteSpecial Paste:=xlPasteValues
  End If

  i=i+1
  Loop

所以它做的是检查该项目是否已存在于列表中。如果是,则用新数据覆盖它。

答案 1 :(得分:2)

听起来我想要使用Dictionary类。这与VBA一起打包但默认情况下未启用 - 您需要通过向“Microsoft Scripting Runtime”添加引用(Tools-&gt; References)来添加它。

“词典”允许您存储键值对。我假设您的样本数据“订单ID”构成一个独特的“记录”。如果是这种情况,这应该有效 - 如果不是这样,只需将密钥更改为定义不同记录的任何内容。

此代码不处理格式化,但您可以轻松管理它。这只是向您展示了当新记录出现时如何更新旧行的值。

Sub CopySheet()
  Dim rw As Range
  Dim findRow, newRow As Integer
  Dim ws1, ws2 As Worksheet
  Dim data As New Scripting.Dictionary
  Dim status, orderId As String

  Set ws1 = Sheets("Sheet1")
  Set ws2 = Sheets("Sheet2")
  newRow = 1

  For Each rw In ws1.Rows
    If ws1.Cells(rw.row, 1).Value2 = "" Then
      Exit For
    End If

    orderId = ws1.Cells(rw.row, 2).Value2
    status = ws1.Cells(rw.row, 5).Value2

    If data.Exists(orderId) Then
      findRow = data(orderId)   ' found it -- replace existing
      If status <> "R" Then     ' if it's not "R", don't overwrite
        findRow = 0
      End If
    Else
      findRow = newRow          ' never seen this order before
      data.Add orderId, findRow ' add it to the dictionary
      newRow = newRow + 1       ' add record on a new line
    End If

    If findRow > 0 Then
      ws2.Range("A" & findRow & ":E" & findRow).Value = _
          ws1.Range("A" & rw.row & ":E" & rw.row).Value
    End If
  Next rw
End Sub

词典非常有效。这意味着如果你有大量的列表,它们就不会像使用vlookup那样遭受典型的Excel性能滞后。

答案 2 :(得分:2)

排序和删除重复项可能会对您有所帮助。

将数据重命名为&#34; raw_data&#34;并在名为&#34; new_data&#34;的同一工作簿中创建新的空白工作表。在工作表new_data&#34;你会得到结果。

尝试以下代码

Sub copy_sheet()

Dim raw_data, new_data As Worksheet

Set raw_data = ThisWorkbook.Sheets("raw_data")
Set new_data = ThisWorkbook.Sheets("new_data")

raw_data.Activate
Range("A1:E1").Select
Range(Selection, Selection.End(xlDown)).Copy
new_data.Activate
Range("A1").PasteSpecial xlPasteValues
Range("A1").Sort key1:=Range("E1"), order1:=xlDescending, Header:=xlYes
Range("A1:E1").Select
Range(Selection, Selection.End(xlDown)).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
Range("A1").Sort key1:=Range("E1"), order1:=xlAscending, Header:=xlYes
Range("A1").Activate
End Sub