Question

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

我在sheet1中也有一个填充了相同列的数据库。我在VBA中编写了一个代码，对于Sheet2中的每一行，我可以填写设备，类型，材料和大小，它将在sheet1中的数据库中搜索这些标准的匹配价格和过去的价格在Sheet2的价格下。

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

如果我在那里更改变量，如何更改/更新第1行和第2行的价格。

我的代码：

<form action="" method="get">
        <input name="filter" type="text">
        <button type="submit" class="btn btn-default">Filtrer</button>
 </form>

现在每次我更改Sheet2中的内容时我都会更新：

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

因此，如果我更改第1行或第2行中的变量，如果第3行是表格中使用的最后一行，我如何更新/更改价格。

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

这是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。您还可以定义要更改的特定单元格也将运行代码。

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

1 个答案: