需要一个额外的循环，所以如果范围0中的单元格然后这样做，否则，如果单元格范围内有数据，然后继续
这个脚本可以工作，但在第一个之后停止，我希望它产生两个结果，所以如果空白单元格select案例pf.Cells(i, 7).Value ，然后继续检查具有数据的单元格并执行所需的情况。
目前它在任何一个行动后都会停止。
Sub NewPortName03() Dim pf As Worksheet, pi As Worksheet, eq As Worksheet Dim Rws As Long, Rng As Range, c As Range, cr Dim s0 As String, s1 As String, s2 As String, s3 As String, s4 As String Set pf = Sheets("PAR Form") Set pi = Sheets("PAR_import") Set eq = Sheets("Equipment details") s0 = "CAT6A" s1 = "RJ45" s2 = "LC-LC" s3 = eq.Cells(4, 4).Value s4 = "" With pf Rws = .Cells(.Rows.Count, "P").End(xlUp).Row Set Rng = .Range(.Cells(2, "P"), .Cells(Rws, "P")) End With For Each c In Rng.Cells cr = c.Row If c = s4 Then pi.Cells(cr + 48, 3).Value = pf.Cells(cr + 0, 26).Value ElseIf c = 1 Then For i = 2 To 34 Select Case pf.Cells(i, 7).Value Case "CAT6A" pi.Cells(i + 48, 3).Value = "PCI-" + eq.Cells(4, 4).Value + "-" + Left(pf.Cells(i, 16), 7) Case "RJ45" pi.Cells(i + 48, 3).Value = "PCI-" + eq.Cells(4, 4).Value + "-" + Left(pf.Cells(i, 16), 7) Case "LC-LC" pi.Cells(i + 48, 3).Value = "PFI-" + eq.Cells(4, 4).Value + "-" + Left(pf.Cells(i, 16), 10) + ":" + pf.Cells(i, 40) + " to " + Left(pf.Cells(i, 17), 10) + ":" + pf.Cells(i, 42) End Select Next i End If Next c End Sub
我收紧了一些代码，并用一个基于For Next的索引replace了For Each。 这组string被塞进一个数组中，导致相同结果的Case标准被堆叠在一起。
Sub NewPortName03() Dim pf As Worksheet, pi As Worksheet, eq As Worksheet Dim Rws As Long, cr As Long Dim vSTRs As Variant Set pf = Sheets("PAR Form") Set pi = Sheets("PAR_import") Set eq = Sheets("Equipment details") vSTRs = Array("CAT6A", "RJ45", "LC-LC", eq.Cells(4, 4).Value2) With pf Rws = .Cells(Rows.Count, "P").End(xlUp).Row For cr = 2 To Rws If Not CBool(Len(.Cells(cr, "P").Value2)) Then pi.Cells(cr + 48, 3) = .Cells(cr + 0, 26).Value ElseIf .Cells(cr, "P").Value2 = 1 Then For i = 2 To 34 Select Case UCase(.Cells(i, 7).Value2) Case vSTRs(0), vSTRs(1) pi.Cells(i & 48, 3) = "PCI-" & vSTRs(3) & "-" & Left(.Cells(i, 16), 7) Case vSTRs(2) pi.Cells(i & 48, 3) = "PFI-" & vSTRs(3) & "-" & Left(.Cells(i, 16), 10) & ":" & .Cells(i, 40) & " to " & Left(.Cells(i, 17), 10) & ":" & .Cells(i, 42) End Select Next i End If Next cr End With End Sub
有一点我仍然关心的是，您正在使用.End(xlUp)来确定PAR窗体工作表的列P中的行的范围。您也正在寻找空白单元格，当您通过列中的值P. P列中是否有散布的空白单元格，或者是否应将“下一个”循环的范围基于另一列？ 换句话说，如果N列到第100行，而P列只到第75行，那么For Next循环当前只能到第75行。