如何实现用户input

我刚刚写完这个Excel的Excel。 我基本上要求我的最终用户总共（例如， $3000 ）find每个客户在列表上花费的总金额，并在一个新的工作表上报告总金额超过$3000 （用户提供的金额）我创build了名为Report

我已经写了这个代码，这也validation了用户input的值：

 Sub Userinput() Dim myValue As Variant myValue = InputBox("Give me some input") Range("E1").Value = myValue If (Len(myValue) < 0 Or Not IsNumeric(myValue)) Then MsgBox "Input not valid, code aborted.", vbCritical Exit Sub End If End Sub 

关于如何使用input值来search客户数据库并find超过input内容并将其放在新工作表中的任何build议？

编辑：数据示例：

 Customer orders Order Date Customer ID Amount purchased 02-Jan-12 190 $580 02-Jan-12 144 $570 03-Jan-12 120 $1,911 03-Jan-12 192 $593 03-Jan-12 145 $332 

Answer 1

尝试这个

 Sub Userinput() Dim cl As Range, cl2 As Range, key, myValue Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary") dic.comparemode = vbTextCompare myValue = InputBox("Give me some input") [E1].Value = "Amount Limit: " & myValue If (Len(myValue) < 0 Or Not IsNumeric(myValue)) Then MsgBox "Input not valid, code aborted.", vbCritical Exit Sub End If For Each cl In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row) If Not dic.exists(cl.Value) Then dic.Add cl.Value, Nothing End If Next cl Set cl = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row) Set cl2 = Range("C2:C" & Cells(Rows.Count, "B").End(xlUp).Row) [E2] = "" For Each key In dic If WorksheetFunction.SumIf(cl, key, cl2) > myValue Then If [E2] = "" Then [E2] = "Customer ID: " & key Else [E2] = [E2] & ";" & key End If End If Next key Set dic = Nothing End Sub 

产量

更新

 Sub Userinput() Dim cl As Range, cl2 As Range, key, myValue, i& Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary") dic.comparemode = vbTextCompare myValue = InputBox("Give me some input") With Sheets("Source") .[E1].Value = "Amount Limit: " & myValue If (Len(myValue) < 0 Or Not IsNumeric(myValue)) Then MsgBox "Input not valid, code aborted.", vbCritical Exit Sub End If myValue = CDec(myValue) For Each cl In .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row) If Not dic.exists(cl.Value) Then dic.Add cl.Value, Nothing End If Next cl Set cl = .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row) Set cl2 = .Range("C2:C" & .Cells(.Rows.Count, "B").End(xlUp).Row) Sheets("Destination").UsedRange.ClearContents Sheets("Destination").[A1] = "Customer ID": i = 2 For Each key In dic If WorksheetFunction.SumIf(cl, key, cl2) > myValue Then Sheets("Destination").Cells(i, "A") = key: i = i + 1 End If Next key End With Set dic = Nothing End Sub 

产量

Answer 2

你可以试试这个。 我假设你需要复制到同一工作簿中的工作表

 Option Explicit Dim MyWorkbook As Workbook Dim MyWorksheet As Worksheet Dim MyOutputWorksheet As Worksheet Sub Userinput() Set MyWorkbook = Workbooks(ActiveWorkbook.Name) Set MyWorksheet = MyWorkbook.Sheets("WorksheetName") Set MyOutputWorksheet = MyWorkbook.Sheets("OutputWorksheetName") Dim myValue As Long Dim RowPointer As Long myValue = InputBox("Give me some input") MyWorksheet.Range("E1").Value = myValue 'conditional checking If (Len(myValue) < 0 Or Not IsNumeric(myValue)) Then MsgBox "Input not valid, code aborted.", vbCritical Exit Sub End If For RowPointer = 2 To MyWorksheet.Cells(Rows.Count, "C").End(xlUp).Row If MyWorksheet.Range("C" & RowPointer).Value > MyWorksheet.Range("E1").Value Then MyWorksheet.Range(("A" & RowPointer) & ":C" & RowPointer).Copy Destination:=MyOutputWorksheet.UsedRange.Offset(1, 0) 'MyOutputWorksheet.UsedRange.Offset(1, 0).Value = MyWorksheet.Rows(RowPointer, 1).EntireRow.Value End If Next RowPointer End Sub 

Answer 3

这是另一种方法，它利用直接的Excelfunction来Copy customer ID列， RemoveDuplicates ， SUMIF基于客户，并Delete那些最低的行。

 Sub CopyFilterAndCountIf() Dim dbl_min As Double dbl_min = InputBox("enter minimum search") Dim sht_data As Worksheet Dim sht_out As Worksheet Set sht_data = ActiveSheet Set sht_out = Worksheets.Add() sht_data.Range("B:B").Copy sht_out.Range("A:A") sht_out.Range("A:A").RemoveDuplicates 1, xlYes Dim i As Integer For i = sht_out.UsedRange.Rows.Count To 2 Step -1 If WorksheetFunction.SumIf( _ sht_data.Range("B:B"), sht_out.Cells(i, 1), sht_data.Range("C:C")) < dbl_min Then sht_out.Cells(i, 1).EntireRow.Delete End If Next End Sub 

我不会对input进行错误检查，但是您可以将其添加到Excel中。我还利用Excel的意愿来处理整列，而不是处理查找范围。 绝对可以更容易理解代码。

还应该提到的是，您可以通过在Sum上使用带有filter的数据透视表来实现所有这些相同的function，而无需使用VBA。