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

Question

所以我有这个X行长的列表。 每个有5列：设备，类型，材料，尺寸和价格这是在Sheet2。

我还在Sheet1中有一个数据库，并填写了相同的列。我已经在VBA中编写了一个代码，对于Sheet2中的每一行我都可以填写设备，类型，材料和大小，并且会在数据库中进行搜索sheet1这些条件的匹配价格，并且在Sheet2列中的价格下面过去。

现在我遇到的问题是，如果我例如填写第1行，第2行和第3行之后，它的作品，并给我的价格，但如果我后来想要更改行1或2中的变量它不会更改/更新价格，但它仍然适用于第3行和前进。

如何修改/更新第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 

如此反复，我的问题我该如何更新/更改价格如果我改变如果第3行是工作表中最后一行，则第1行或第2行中的变量。

这是我使用的datbase：

这是Sheet2中：

Answer 1

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_Change。您还可以定义正在更改的特定单元将运行代码。