如何刷新循环或更新VBA中的循环

所以我有这个X行长的列表。 每个列有5列:设备,types,材料,尺寸和价格,在Sheet2中。

我也在sheet1中有一个数据库,里面填写了相同的列。我已经在VBA中编写了一个代码,对于Sheet2中的每一行,我都可以填写设备,types,材料和大小,它将在sheet1的数据库中search匹配的价格对于这些标准,并在Sheet2中的价格栏下过去。

现在我的问题是,如果我例如填写行1,行2和行3之后,它的工作,并给我的价格,但如果我后来想改变行1或2的variables,它不会改变/更新价格,但它仍然适用于第3行和转发。

我如何使它变化/如果我在那里更改variables,更新第1行和第2行的价格。

我的代码:

Option Explicit Public r As Long Public Const adOpenStatic = 3 Public Const adOpenKeySet = 1 Public Const adLockReadOnly = 1 Sub cmdSearch_Click() Dim strCriteriaEquipment As String Dim strCriteriaType As String Dim strCriteriaMaterial As String Dim strCriteriaSize As String Dim strSQL As String Dim strSourceTable As String Dim c As Long, LR As Long LR = Cells(Rows.Count, 2).End(xlUp).Row For r = 1 To LR c = 2 With Worksheets("Summary") strCriteriaEquipment = Worksheets("Summary").Cells(r, c).Value strCriteriaType = Worksheets("Summary").Cells(r, c + 1).Value strCriteriaMaterial = Worksheets("Summary").Cells(r, c + 2).Value strCriteriaSize = Worksheets("Summary").Cells(r, c + 3).Value End With Next r strSourceTable = "[DB$" & Replace(Worksheets("DB").Range("SourceData").Address, "$", "") & "]" strSQL = "SELECT [Price] FROM " & strSourceTable & vbNewLine strSQL = strSQL & "WHERE [Equipment]= """ & strCriteriaEquipment & """" & vbNewLine strSQL = strSQL & "AND [Type]=""" & strCriteriaType & """" & vbNewLine strSQL = strSQL & "AND [Material]=""" & strCriteriaMaterial & """" & vbNewLine strSQL = strSQL & "AND [Size]=""" & strCriteriaSize & """;" Dim rstRecordSet As Object 'ADODB.Recordset Dim con As Object 'ADODB.Connection Dim strWorkBookPath As String strWorkBookPath = ThisWorkbook.FullName Set con = CreateObject("ADODB.Connection") Set rstRecordSet = CreateObject("ADODB.RecordSet") con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & strWorkBookPath & ";" & _ "Extended Properties=""Excel 8.0;HDR=Yes"";" rstRecordSet.Open strSQL, con, adOpenStatic, adLockReadOnly With Worksheets("Summary") For r = r - 29 To LR c = 5 If Not (rstRecordSet.EOF And rstRecordSet.BOF) Then .Range("ResultTable").Cells(r, c).CopyFromRecordset rstRecordSet Else .Range("ResultTable").Cells(r, c).Value = "Data Not Found!" End If Next r End With rstRecordSet.Close con.Close Set rstRecordSet = Nothing Set con = Nothing strWorkBookPath = vbNullString strSQL = vbNullString strCriteriaEquipment = vbNullString strCriteriaType = vbNullString strCriteriaMaterial = vbNullString strCriteriaSize = vbNullString strSourceTable = vbNullString End Sub Public Function UniqueStringWithDelimiter(varArray As Variant, strDelimiter As String) As Variant Dim varTemp() As Variant Dim lngLoop As Long Dim strConcat As String ReDim Preserve varTemp(0 To 0) varTemp(0) = varArray(0, 0) strConcat = strConcat & varArray(0, 0) For lngLoop = 1 To UBound(varArray, 2) If InStr(1, strConcat, varArray(0, lngLoop), vbTextCompare) = 0 Then strConcat = strConcat & strDelimiter & varArray(0, lngLoop) End If Next lngLoop UniqueStringWithDelimiter = strConcat. strConcat = vbNullString Erase varTemp End Function 

现在更新每次我在Sheet2中改变一些东西,我只写了这个:

 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Call cmdSearch_Click End Sub 

所以再次我的问题我如何更新/更改价格,如果我更改行1或行2中的variables,如果行3是表中使用的最后一行。

这是我正在使用的数据库:
这是我正在使用的数据库

这是Sheet2:
这是Sheet2

1)我看到的一个直接的问题会引起你的问题(可能还有更多的问题,但是现在我没有时间去分析这么多),那么最初的循环是:

 For r = 1 To LR c = 2 With Worksheets("Summary") strCriteriaEquipment = Worksheets("Summary").Cells(r, c).Value strCriteriaType = Worksheets("Summary").Cells(r, c + 1).Value strCriteriaMaterial = Worksheets("Summary").Cells(r, c + 2).Value strCriteriaSize = Worksheets("Summary").Cells(r, c + 3).Value End With Next r 

没有做你所期望的。 在这个循环结束时,你只需要设置最后一行数据的值(我怀疑是第3行)就可以传入你的查询。

您需要在这个循环中编写查询,以便每行中的每个条件都运行查询。

例如:

 For r = 1 to LR c = 2 With Worksheets("Summary") 'code to set criteria End With 'code to download data price 'code to stick data and price in summary tab Next r 

2)另外,确保限定所有的对象。 该线

 LR = Cells(Rows.Count, 2).End(xlUp).Row 

如果您希望激活的工作表实际上不活动,可能会返回不同的结果。 比如,最好这样说,而不要猜测工程:

 LR = Worksheets("Summary").Cells(Rows.Count, 2).End(xlUp).Row 

3)使用Worksheet_SelectionChange将在Worksheet_SelectionChange 每次从一个移动到另一个时激发您的代码。 如果您只想在更改数据中的条件时触发代码,请改用Worksheet_Change 。 您也可以定义正在更改的特定单元格也将运行该代码。