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

我是新来的，事先道歉。

此代码在一张表中search列中的特定值，存储find的值的行引用，然后使用它将input值复制到电子表格中，然后将输出值复制到摘要中。 它的工作原理…但有没有办法设置“设置”variables循环？

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" 

因为如果没有正确的数据就没有办法testing，可能会有一些错误：P