ループをリフレッシュする方法、またはVBAでループを更新する方法

Question

このリストはX行長くなっています。 それぞれには、シート、機器、タイプ、材料、サイズ、価格の5つの列があります。

私は同じ列が記入されたsheet1のデータベースも持っています。私はVBAでSheet2の各行に機器、タイプ、マテリアル、サイズを記入できるコードを書いています。 sheet1これらの条件の一致する価格とこれをSheet2のPrice列の下に表示します。

ここで問題となるのは、たとえば行1、行2、行3のそれぞれを入力した後に価格が下がっても、後で行1または2の変数を変更したい場合です価格を変更/更新することはありませんが、それでも3行目以降は有効です。私はそこに変数を変更した場合、それは変更/行1および2に価格を更新しないように

は、どのように私はそれを作るのですか。

私のコード：だからもう一度私が変更された場合、私は更新しない/価格を変更する方法私の質問を

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

：今

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で何かを変更行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を使用してください。コードを実行する変更対象の特定のセルも定義することができます。