如何在循环中定义“设置”变量？

Question

我是新手，事先道歉。

该代码在一张表中搜索列中的特定值，存储找到的值的行引用，然后使用它将输入值复制到电子表格中，然后将输出值复制到摘要中。它的工作原理......但有没有办法将“设置”变量设置为循环？

Dim i As Long 

Dim wb As Workbook 
Dim sht1 As Worksheet 
Dim sht2 As Worksheet 
Dim RNG(1 To 8) As Range 
Dim MyVal As Variant 

'Set value of rows to work down 
MyVal = InputBox("To what row to calculate", "Enter a row number", 36) 

If MyVal > 52 Then 
MsgBox ("You can't enter a number greater than 52") 
MyVal = InputBox("To what row to calculate", "Enter a row number", 52) 
End If 


Set wb = ThisWorkbook 
Set sht1 = wb.Sheets("Individual Carry") 
Set sht2 = wb.Sheets("Detail") 
Set RNG1 = sht2.Range("A:A").Find("V1", LookIn:=xlValues, LookAt:=xlWhole) 
Set RNG2 = sht2.Range("A:A").Find("V2", LookIn:=xlValues, LookAt:=xlWhole) 
Set RNG3 = sht2.Range("A:A").Find("V3", LookIn:=xlValues, LookAt:=xlWhole) 
Set RNG4 = sht2.Range("A:A").Find("V4", LookIn:=xlValues, LookAt:=xlWhole) 
Set RNG5 = sht2.Range("A:A").Find("V5", LookIn:=xlValues, LookAt:=xlWhole) 
Set RNG6 = sht2.Range("A:A").Find("V6", LookIn:=xlValues, LookAt:=xlWhole) 
Set RNG7 = sht2.Range("A:A").Find("V7", LookIn:=xlValues, LookAt:=xlWhole) 
Set RNG8 = sht2.Range("A:A").Find("V8", LookIn:=xlValues, LookAt:=xlWhole) 

'Set variables equal to Rows of output cells 
V1 = RNG1.Row 
V2 = RNG2.Row 
V3 = RNG3.Row 
V4 = RNG4.Row 
V5 = RNG5.Row 
V6 = RNG6.Row 
V7 = RNG7.Row 
V8 = RNG8.Row 

'Clear result range 
sht1.Range("U8:Z52").ClearContents 

'Loop through assumptions and copy outputs to result field 
For i = 8 To MyVal 
    'Copy inputs into calculation sheet 
    sht2.Range("J" & V1) = sht1.Range("D" & i).Value 
    sht2.Range("E" & V2) = sht1.Range("E" & i).Value 
    sht2.Range("E" & V2 + 1) = sht1.Range("F" & i).Value 
    sht2.Range("E" & V2 + 2) = sht1.Range("G" & i).Value 
    sht2.Range("E" & V2 + 3) = sht1.Range("H" & i).Value 
    sht2.Range("E" & V2 + 4) = sht1.Range("I" & i).Value 
    sht2.Range("E" & V2 + 5) = sht1.Range("J" & i).Value 
    sht2.Range("E" & V2 + 6) = sht1.Range("K" & i).Value 
    sht2.Range("E" & V2 + 7) = sht1.Range("L" & i).Value 
    sht2.Range("E" & V2 + 8) = sht1.Range("M" & i).Value 
    sht2.Range("E" & V2 + 9) = sht1.Range("N" & i).Value 
    sht2.Range("E" & V2 + 10) = sht1.Range("O" & i).Value 
    sht2.Range("E" & V2 + 11) = sht1.Range("P" & i).Value 
    sht2.Range("E" & V2 + 12) = sht1.Range("Q" & i).Value 
    sht2.Range("E" & V2 + 13) = sht1.Range("R" & i).Value 
    sht2.Range("E" & V2 + 14) = sht1.Range("S" & i).Value 
    sht2.Range("E" & V2 + 15) = sht1.Range("T" & i).Value 

    'Copy result to inputs sheet 
    sht1.Range("U" & i).Value = sht2.Range("E" & V3)/1000 
    sht1.Range("V" & i).Value = sht2.Range("E" & V4)/1000 

    sht1.Range("W" & i).Value = sht2.Range("E" & V5)/1000 
    sht1.Range("X" & i).Value = sht2.Range("E" & V6)/1000 

    sht1.Range("Y" & i).Value = sht2.Range("E" & V7)/1000 
    sht1.Range("Z" & i).Value = sht2.Range("E" & V8)/1000 

Next i 

MsgBox ("Command Complete") 

Answer 1

集中的部分，你在问：

Dim arrVals, R() As Long, x, wb As Workbook, sht2 As Worksheet 

'all the values to be located in ColA... 
arrVals = Array("V1", "V2", "V3", "V4", "V5", "V6", "V7", "V8") 

Set wb = ThisWorkbook 
Set sht2 = wb.Sheets("Detail") 

'resize the "rows" array to have the same # of elements as arrVals 
ReDim R(1 To UBound(arrVals) + 1) '+1 is because arrVals is zero-based 

For x = 1 To UBound(R) 
    'Note: if there's any possibility of a value not being found, this will error 
    '  at runtime 
    R(x) = sht2.Range("A:A").Find(arrVals(x - 1), LookIn:=xlValues, LookAt:=xlWhole).Row 
Next x 

Debug.Print R(3) 'just checking one of the values... 

'R(1) is now the same as V1 in you posted code, R(2)=V2, etc 

Answer 2

如果使用上升记号从1开始，也是一个集合会做，就像这样：

Dim sht As Worksheet, MyVal As Variant, x As Variant 
Dim MyCol As New Collection, i As Long 

'Set value of rows to work down 
MyVal = 53 
While MyVal > 52 
    MyVal = InputBox("To what row to calculate", "Enter a row number", 36) 
    If Not IsNumeric(MyVal) Then Exit Sub 
    If MyVal > 52 Then MsgBox ("You can't enter a number greater than 52") 
Wend 

With ThisWorkbook.Sheets("Detail") 
    Set sht = .Parent.Sheets("Individual Carry") 

    For Each x In Evaluate("""v""&ROW(1:8)") 
    MyCol.Add .Columns(1).Find(x, , &HEFBD, 1).Row 
    Next 

    'Clear result range 
    sht.[U8:Z52].ClearContents 

    'Loop through assumptions and copy outputs to result field 
    For x = 8 To MyVal 
    'Copy inputs into calculation sheet 
    .Cells(MyCol(1), 10).Value2 = sht.Cells(x, 4).Value2 
    .Cells(MyCol(2), 5).Resize(15).Value2 = Application.Transpose(sht.Cells(x, 5).Resize(, 15).Value2) 

    'Copy result to input sheet 
    For i = 3 To 8 
     sht.Cells(x, 18 + i).Value2 = .Cells(MyCol(i), 5).Value2/1000 
    Next 
    Next 
End With 

MsgBox "Command Complete" 

因为有是没有办法测试这个没有适当的数据，可能会有一些错误：P