英文:
How to make a loop pull values from another sheet?
问题
I'm trying to create a loop that pulls values from another sheet in the workbook.
For i = 3 To 1000
Worksheets("Cable Estimate").Select
If Cells(i, 1) = "" Then
If Equipment = "Station Service Transformer" Then Worksheets("Equipment List").Range("A2:D9").Copy Worksheets("Cable Estimate").Range(Cells(i, 1), Cells(i, 4))
Exit For
If Equipment = "13kV PTs (3 phase)" Then Worksheets("Equipment List").Range("A11:D15").Copy Worksheets("Cable Estimate").Range(Cells(i, 1), Cells(i, 4))
Exit For
If Equipment = "13kV Tie Breaker" Then Worksheets("Equipment List").Range("A18:D26").Copy Worksheets("Cable Estimate").Range(Cells(i, 1), Cells(i, 4))
Exit For
End If
Next i
The "Equipment" variable is set to equal a combo box value which is a list of material populated from another sheet. The exit for is listed under each piece of equipment such that the command only pulls the data from the other worksheet once.
When "Station Service Transformer" is selected (the first value in the combobox) the code pulls correctly into my sheet, however the code does not pull correctly any of the following equipment below that one. I believe I'm missing something either before or after each "exit for" statement. I also believe it may need some extra code like an "else if" if the cell value is not blank as in the first condition `If Cells(i, 1) = "" Then`.
<details>
<summary>英文:</summary>
I'm trying to create a loop that pulls values from another sheet in the workbook.
For i = 3 To 1000
Worksheets("Cable Estimate").Select
If Cells(i, 1) = "" Then
If Equipment = "Station Service Transformer" Then Worksheets("Equipment List").Range("A2:D9").Copy Worksheets("Cable Estimate").Range(Cells(i, 1), Cells(i, 4))
Exit For
If Equipment = "13kV PTs (3 phase)" Then Worksheets("Equipment List").Range("A11:D15").Copy Worksheets("Cable Estimate").Range(Cells(i, 1), Cells(i, 4))
Exit For
If Equipment = "13kV Tie Breaker" Then Worksheets("Equipment List").Range("A18:D26").Copy Worksheets("Cable Estimate").Range(Cells(i, 1), Cells(i, 4))
Exit For
End If
Next i
The "Equipment" variable is set to equal a combo box value which is a list of material populated from another sheet. The exit for is listed under each piece of equipment such that the command only pulls the data from the other worksheet once.
When "Station Service Transformer" is selected (the first value in the combobox) the code pulls correctly into my sheet, however the code does not pull correctly any of the following equipment below that one. I believe I'm missing something either before or after each "exit for" statement. I also believe it may need some extra code like an "else if" if the cell value is not blank as in the first condition `If Cells(i, 1) = "" Then`.
Sidenote: I made the formula work by creating a separate `for i = 3 to 1000` and placing an "exit for" and "end if" for each piece of equipment but I was hoping to make it all work under one "i".
</details>
# 答案1
**得分**: 1
请尝试如上建议。还要注意对所有范围进行完整的限定。
你复制和粘贴的范围似乎不太合理。被复制的范围有多行，因此在粘贴时可能会覆盖单元格。
最后，如果“Equipment”不会改变其值，你可以将其从循环中移出，并缩短代码。
___
根据新的要求进行修订
Dim r As Range
With Worksheets("Cable Estimate")
On Error GoTo 0 '避免在没有空白单元格时出错
Set r = .Range(.Cells(3, 1), .Cells(1000, 1)).SpecialCells(xlCellTypeBlanks)(1)
On Error Resume Next
End With
If Not r Is Nothing Then
If Equipment = "Station Service Transformer" Then
Worksheets("Equipment List").Range("A2:D9").Copy r
ElseIf Equipment = "13kV PTs (3 phase)" Then
Worksheets("Equipment List").Range("A11:D15").Copy r
ElseIf Equipment = "13kV Tie Breaker" Then
Worksheets("Equipment List").Range("A18:D26").Copy r
End If
End If
<details>
<summary>英文:</summary>
Try this, as suggested above. Note too the full qualification of all ranges.
Your copy and paste ranges don't make much sense though. The ranges being copied are several rows long so you may end up overwriting cells when you paste.
Lastly, if `Equipment` doesn't change value, you could take it out of the loop and shorten the code.
With Worksheets("Cable Estimate")
For i = 3 To 1000
If .Cells(i, 1) = "" Then
If Equipment = "Station Service Transformer" Then
Worksheets("Equipment List").Range("A2:D9").Copy .Range(.Cells(i, 1), .Cells(i, 4))
ElseIf Equipment = "13kV PTs (3 phase)" Then
Worksheets("Equipment List").Range("A11:D15").Copy .Range(.Cells(i, 1), .Cells(i, 4))
ElseIf Equipment = "13kV Tie Breaker" Then
Worksheets("Equipment List").Range("A18:D26").Copy .Range(.Cells(i, 1), .Cells(i, 4))
End If
End If
Next i
End With
___
Revised in light of new requirements
Dim r As Range
With Worksheets("Cable Estimate")
On Error GoTo 0 'avoid error if there are no blanks
Set r = .Range(.Cells(3, 1), .Cells(1000, 1)).SpecialCells(xlCellTypeBlanks)(1)
On Error Resume Next
End With
If Not r Is Nothing Then
If Equipment = "Station Service Transformer" Then
Worksheets("Equipment List").Range("A2:D9").Copy r
ElseIf Equipment = "13kV PTs (3 phase)" Then
Worksheets("Equipment List").Range("A11:D15").Copy r
ElseIf Equipment = "13kV Tie Breaker" Then
Worksheets("Equipment List").Range("A18:D26").Copy r
End If
End If
</details>
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论