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

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

2 个答案: