我正在尝试构建一个从一个工作表中获取数据的Excel工作簿，并根据系统名称填充另一个工作簿。我遇到了下一个循环的第一个问题。它适用于第一个系统，但如果系统中有多个项目，它就会停止工作。每个循环的第二个效果很好。有没有更好的方法来运行我的第一个循环。我尝试一个如果第一个For每个变量匹配第二个然后每个增量，但代码说下一个Inspectcell没有为每个。系统名称始终位于C列，从C7开始
Sub fillthereport()
Dim xx As Variant, ws As Variant, yy As Variant
Dim ws2 As Variant, xxx As Variant, yyy As Variant
Dim rowed As Integer, b As Integer
'Dim MySht As Worksheet
Dim MyPic As Shape
Dim MyLeft As Single, MyTop As Single
Dim conv As Variant
Dim item As Variant
Dim picnum As Variant
Dim mergecells As String, mergecells2 As String, mergecolor As String
Dim horstart As Variant, horend As Variant
Dim verstart As Variant, verend As Variant
Dim Inspectcell As Range, reportcell As Range
'worksheets loop operator
ws = 1
'worksheets loop operator to
ws2 = 6
'row designator from
xx = 7
'column designator from
yy = 3
'row designator to
xxx = 68
'column designator to
yyy = 37
'This is not the variable you are looking for
b = 0
'These are the variables you are looking for
yel = 0
bl = 0
re = 0
Folderpath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
reportcell = Worksheets("inspection Data").Range("C7")
'make extra sheets in the report to be filled
For Each Inspectcell In Worksheets("inspection Data").Range("C7:C18")
If Inspectcell = reportcell Then
Worksheets(ws2).Select
Worksheets(ws2).Range("A60:AY114").Select
Selection.Copy
Sheets(ws2).Range("A115:AY169").Select
ActiveSheet.Paste
Sheets(ws2).Range("A170:AY224").Select
ActiveSheet.Paste
'reportcell = Inspectcell
For Each reportcell In Worksheets("inspection Data").Range("C7:C18")
If reportcell = Inspectcell Then
'(This is about 110 lines of code that work great)
xx = xx + 1
b = b + 1
'worksheets loop operator
'ws = ws + 1
'worksheets loop operator to
'ws2 = ws2 + 1
'column designator from
'yy = yy + 1
'row designator to
If Not b Mod 3 = 0 Then
xxx = xxx + 16
Else
xxx = xxx + 23
End If
Else 'If xx = 15 Then
Exit For
End If
'xxx = xxx + 22
Next reportcell
ws2 = ws2 + 1
'Else
'Exit for
End if
Next Inspectcell