在“列"中查找相同的数据并将其过滤到另一张表 [英] Find identical data in Column and filter it to another sheet
问题描述
我已经花了几个小时编写这段代码，并且确实需要更好的专家意见.
工作表1的A列具有动态数据列表，通常是IP地址，但对于它来说，它只是一个数字.可以有重复项.
我需要在A列中找到所有相同的数据，选择它，并为其运行特定的代码，然后为A中的每组相同数据运行相同的代码.我的代码是在C列中找到与小于4或小于4的标准.C列的值将仅为1到5.目标是针对A中每组相同的数据，然后查看C并选择C中只有1、2或3的任何值，而不是4或5的任何值.5，然后将整个行复制到另一张纸上.
我的代码可以工作，但是有点慢，并且不能说明是否没有要复制的数据.
现在，我使用名为Test的工作表从A中查找唯一数据，然后将A中的相同数据复制到名为mm的工作表中，过滤数据，然后仅将过滤后的数据复制到工作表数据中.M的内容在每个循环中都被删除，并且Test在代码的末尾被删除.
请帮助我清理并使其更快.如果您想查看示例数据，请在下面找到图片链接.
信用是christodorov的帮助，因为我使用了他的基本代码.
将currentCell调整为LongDim numOfValues只要长子filterNextResult()'将数据从数据表的A列(如果需要可以更改)复制并移动到新的名为"temp"的表中'检查以确保临时表A列中至少有1个数据点如果currentCell = 0，则Application.ScreenUpdating = False致电createNewTempApplication.ScreenUpdating =真万一'在临时表的A列中找到要过滤的唯一数据点的总数如果numOfAccounts = 0，则Application.ScreenUpdating = False呼叫findNumOfValuesApplication.ScreenUpdating =真万一Dim X作为整数暗淡如龙尽可能长的Dim lrdata昏暗Lastmm作为整数lr = Sheets("mm").Cells(Rows.Count，"A").End(xlUp).Row + 1lrdata = Sheets("data").Cells(Rows.Count，"A").End(xlUp).Row + 1currentCell = 2numOfValues = 21'MsgBox(currentCell)关于错误继续对于X = 1到numOfValues与Sheet1.UsedRange.AutoFilter 1，Worksheets("temp").Range("A"& currentCell).Value设置filRange = .Offset(1).Resize(.Rows.Count-1，1).SpecialCells(xlCellTypeVisible)如果不是IsEmpty(filRange)，则filRange.EntireRow.Copy目标:= Sheets("mm").Range("A"& lr)工作表("mm").激活范围("A1").选择'Range("A1"& .Cells(Rows.Count，1).End(xlUp).Row).Select有范围("A1")'.自动过滤.AutoFilter字段:= 3，条件1:=< 4"Lastmm = ActiveSheet.Cells(Rows.Count，1).End(xlUp).Row范围("A2:C"和Lastmm).选择选择复制工作表(数据").激活范围("A"& lrdata).粘贴特殊粘贴:= xlPasteValuesApplication.CutCopyMode =假lrdata = Sheets("data").Cells(Rows.Count，"A").End(xlUp).Row + 1工作表("mm").激活范围("A1").选择工作表("mm").AutoFilterMode = FalseLastmm = ActiveSheet.Cells(Rows.Count，1).End(xlUp).Row范围("A2:C"和Lastmm).选择Selection.Delete shift:= xlToLeft结束于'Range("A1"& .Cells(Rows.Count，1).End(xlUp).Row).Select'随着选择'lr = Sheets("mm").Cells(Rows.Count，"A").End(xlUp).Row + 1万一currentCell = currentCell + 1MsgBox(currentCell)'MsgBox(numOfValues)'.自动过滤结束于下一个XApplication.DisplayAlerts = False工作表(临时").删除Application.DisplayAlerts = True结束子'sub将在临时表a上查找值的数量私人子findNumOfValues()'计算非空单元格的数量，并将该值(在本例中为标题，减去1)分配给numOfValuesnumOfValues = Worksheets("temp").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count'MsgBox(numOfValues)结束子私人子createNewTemp()Sheet1.Range("A:C").Copy'ActiveWorkbook.Sheets.Add.Name ="temp"Sheets.Add(After:= Sheets(Sheets.Count)).Name ="temp"'删除重复项工作表("temp").范围("A1").选择使用ActiveWorkbook.ActiveSheet.粘贴.Range("A:C").RemoveDuplicates列:= Array(1)，标题:= xlYes结束于检查以确保临时表中有副词如果Worksheets("temp").Range("A2").Value ="然后MsgBox没有过滤器值"结尾别的currentCell = 2万一'MsgBox(currentCell)Sheet1.激活Sheet1.Range("A1").SelectSelection.AutoFilter结束子
有3种方法来引用工作表:
- 工作表名称(或标签名称)-用户在标签中可见的名称(左下角)
- 工作表索引(或标签索引)-用户显示的标签顺序(左下角)
- CodeName-这是仅在VBA编辑器中可见的工作表的名称(左上方)
在下面的代码中，我们指的是同一张纸:
公共子SheetNames()昏暗的ws2作为工作表ws2 = Sheets("Sheet2")'标签名称ws2 = Sheets(2)'Tab索引ws2 = Sheet2'CodeName(仅在VBA编辑器中可见)结束子 参考工作表:
CodeName在VBA中更可靠，因为普通用户不会编辑(不太可能更改)
另一个需要区分的地方是 Sheets()集合和 Worksheets()集合:
Sheets集合不仅包括工作表的集合，还包括其他类型的表，以包括图表表(...)
( Example spreadsheet looks like this This will iterate through each unique value in column A, Sheet1 with these steps
Option Explicit
Public Sub FindIdenticalInALessThan4InC()
Const COL_A = 1
Const COL_C = 3
Const LESS_THAN_4 = "<4"
Dim ws1 As Worksheet, ws2 As Worksheet, lrWs1 As Long, lrWs2 As Long
Dim arrA As Variant, d As Object, i As Long, unique As Variant, maxRows As Long
Set ws1 = Sheet1: Set ws2 = Sheet2 'ws2 = CodeName for Sheets("mm")
maxRows = Rows.Count
If ws1.AutoFilterMode Then ws1.UsedRange.AutoFilter 'clear filters
lrWs1 = ws1.Cells(maxRows, "A").End(xlUp).Row + 1
lrWs2 = ws2.Cells(maxRows, "A").End(xlUp).Row + 1
If lrWs1 > 1 Then 'expects first row as headers
Set d = CreateObject("Scripting.Dictionary")
arrA = ws1.Range(ws1.Cells(1, COL_A), ws1.Cells(lrWs1, COL_A))
For i = 2 To lrWs1
d(arrA(i, 1)) = vbNullString 'get uniques from col A
Next
Application.ScreenUpdating = False
For Each unique In d
With ws1.UsedRange
.AutoFilter Field:=COL_A, Criteria1:=unique
.AutoFilter Field:=COL_C, Criteria1:=LESS_THAN_4, Operator:=xlAnd
If .Columns(1).SpecialCells(xlCellTypeVisible).CountLarge > 1 Then
.Offset(1).Resize(lrWs1 - 2, .Columns.Count).Copy ws2.Cells(lrWs2, "A")
lrWs2 = ws2.Cells(maxRows, "A").End(xlUp).Row + 1
End If
.AutoFilter
End With
Next
Application.ScreenUpdating = True
End If
End Sub
Sheet1 and Sheet2
Edit:
There are 3 ways to refer to sheets:
- Sheet Name (or Tab Name) - The name visible by user in the tab (lower-left)
- Sheet Index (or Tab Index) - The order of the tab as it appears to the user (lower-left)
- CodeName - this is the name of the sheet only visible in the VBA editor (top-left)
In the code bellow we are referring to the same sheet:
Public Sub SheetNames()
Dim ws2 As Worksheet
ws2 = Sheets("Sheet2") 'Tab Name
ws2 = Sheets(2) 'Tab Index
ws2 = Sheet2 'CodeName (visible only in the VBA editor)
End Sub
References to the sheet:
The CodeName is more reliable in VBA because normal users will not edit it (unlikely to change)
Another distinction to be made is between the Sheets() collection and the Worksheets() collection:
The Sheets collection consist of not only a collection of worksheets but also other types of sheets to include Chart sheets (...)
这篇关于在“列"中查找相同的数据并将其过滤到另一张表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
