我有数据表,我想在其他表格中获取数据但有条件。例如:
-------------------------------------------------
| 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中的记录。谢谢
答案 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