VBA提取所有相关数据并进行sorting和validation

好的，这里的情况，

我有4个标准：

1. 区
2. 最大价格
3. 最小尺寸
4. 客房

我有一个工作表（OnSale）所需的所有值的数据列表，我只需要运行之间的特定algorithm来理清这些标准：

1. 区域（整数）是否是客户select的区域
2. 如果价格（整数）小于最大价格
3. 如果大小大于最小大小（整数）
4. 如果房子有客户select的房间数量（整数）。

如果工作表（OnSale）列表中的数据符合上述要求，则会首先创build一个表格，然后按照以下所示添加符合上述所有条件的家庭的详细信息。 （项目|单位数量|价格|价格（psf）|价格（每平方米）|面积（平方米）|床位|使用权限（发现在售货上）

最后，如果表格没有结果，我需要它自动删除新的工作表，并通知用户目前没有这种销售。 < – 可能MsgBox。 我真的希望有人可以帮助我这个CUS我真的是新的VBA，需要做到这些事情发生:(真的很感激，如果有人可以帮助。

提前致谢！

这是我到目前为止，但代码不会导致我任何结果

Option Explicit Sub finddata() Dim district As String Dim maxPrice As Long Dim minSize As Integer Dim room As Integer Dim finalRow As Integer Dim i As Integer Sheets("Alakazam").Range("A2:M1048576").ClearContents district = Sheets("RealEstateAmigo!").Range("T4").Value maxPrice = Sheets("RealEstateAmigo!").Range("T5").Value minSize = Sheets("RealEstateAmigo!").Range("T6").Value room = Sheets("RealEstateAmigo!").Range("T7").Value finalRow = Sheets("OnSale").Range("A10000").End(xlUp).Row For i = 2 To finalRow 'to loop & check every single value If Cells(i, 1) = district Then ' if district match If Cells(i, 3) < maxPrice Then 'if less than MaxPrice If Cells(i, 6) > minSize Then 'if greater than minSize If Cells(i, 7) = room Then ' if room number match Range(Cells(i, 1), Cells(i, 13)).Copy 'Copy the rows Sheets("Alakazam").Range("A2").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats End If End If End If End If Next i Sheets("Alakazam").Select Sheets("Alakazam").Range("A2").Select End Sub 

Answer 1

正如我在上面的评论中提到的那样，您可以使用Autofilter来获得所需的结果。 我已经详细地评论了代码，但如果您有一些问题，请在评论中提问:)

 Sub finddata() Dim district As String Dim maxPrice As Long, minSize As Integer, room As Integer, finalRow As Long Dim sh As Worksheet Dim data As Range Dim rng As Range 'try to get sheet if it exist On Error Resume Next Set sh = Sheets("Alakazam") On Error GoTo 0 'if it not exist - create it If sh Is Nothing Then Set sh = ThisWorkbook.Worksheets.Add sh.Name = "Alakazam" End If sh.Range("A2:M" & Rows.Count).ClearContents 'get criterias With Sheets("RealEstateAmigo!") district = .Range("T4").Value maxPrice = .Range("T5").Value minSize = .Range("T6").Value room = .Range("T7").Value End With With Sheets("OnSale") finalRow = .Range("A" & .Rows.Count).End(xlUp).Row Set data = .Range("A1:M" & finalRow) 'clear all previous filters .AutoFilterMode = False 'apply filters to match criterias With data .AutoFilter Field:=1, Criteria1:=district .AutoFilter Field:=3, Criteria1:="<" & maxPrice .AutoFilter Field:=6, Criteria1:=">" & minSize .AutoFilter Field:=7, Criteria1:="=" & room 'try to get visible rows - thouse that matches criteria On Error Resume Next Set rng = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) On Error GoTo 0 If rng Is Nothing Then 'if nothing found - show error message + delete sheet MsgBox "There is no rows matched all criterias" Application.DisplayAlerts = False sh.Delete Application.DisplayAlerts = True Else 'if data found - copy to sheet Alakazam data.Rows(1).Copy sh.Range("A1").PasteSpecial xlPasteValues sh.Range("A1").PasteSpecial xlPasteFormats 'copy headers rng.Copy sh.Range("A2").PasteSpecial xlPasteValues sh.Range("A2").PasteSpecial xlPasteFormats Application.CutCopyMode = False sh.Select End If End With 'disable all filters .AutoFilterMode = False End With End Sub