循环单元偏移？

我对VBA非常陌生我已经做了几个macros来帮助加速车间里的工作stream程，使工作表自动化等等，所以请原谅任何冗长的代码，但是这个让我难住了。

我们有一个用于我们的机器的工具表，我想自动化它，当你把一个4位数的代码放到一个单元格中时，例如“1 4 AV”，它会用另一个参数工作表中的更详细的描述填写工具表的各个部分，这里是代码。

Sub toolsheet() 'START box 1----------------------------------------- Dim Box1 As String Dim Box1Array() As String Box1 = Cells(6, "B").Value Box1Array = Split(Box1) 'TOOL DESCRIPTION ---------------------------------------- If Box1Array(0) = 1 Then Worksheets(1).Range("C7") = Worksheets(4).Range("G3") Worksheets(1).Range("B7") = 1 ElseIf Box1Array(0) = 2 Then Worksheets(1).Range("C7") = Worksheets(4).Range("G4") Worksheets(1).Range("B7") = 2 ElseIf Box1Array(0) = 3 Then Worksheets(1).Range("C7") = Worksheets(4).Range("G5") Worksheets(1).Range("B7") = 3 ElseIf Box1Array(0) = 4 Then Worksheets(1).Range("C7") = Worksheets(4).Range("G6") Worksheets(1).Range("B7") = 4 ElseIf Box1Array(0) = 5 Then Worksheets(1).Range("C7") = Worksheets(4).Range("G7") Worksheets(1).Range("B7") = 5 ElseIf Box1Array(0) = 6 Then Worksheets(1).Range("C7") = Worksheets(4).Range("G8") Worksheets(1).Range("B7") = 6 ElseIf Box1Array(0) = 7 Then Worksheets(1).Range("C7") = Worksheets(4).Range("G9") Worksheets(1).Range("B7") = 7 ElseIf Box1Array(0) = 8 Then Worksheets(1).Range("C7") = Worksheets(4).Range("G10") Worksheets(1).Range("B7") = 8 ElseIf Box1Array(0) = 9 Then Worksheets(1).Range("C7") = Worksheets(4).Range("G11") Worksheets(1).Range("B7") = 9 ElseIf Box1Array(0) = 10 Then Worksheets(1).Range("C7") = Worksheets(4).Range("G12") Worksheets(1).Range("B7") = 10 End If End Sub 

我有两个问题。 1，如果在单元格中没有任何分裂它会抛出一个错误和2，我想重复这个过程16次，每次从工作表1中的最后3个单元格，但保持相同的参数读取在工作表4，I我们尝试用偏移量循环，但如果单元格中没有任何内容，则会再次抛出错误。

谢谢你的帮助

伊恩

编辑：

感谢您的帮助，我现在已经完成了代码的运行，并且完美地工作，但前提是我完全input了信息。

 If Len(Join(Box1Array)) > 0 Then If Box1Array(1) = 1 Then Range("I5").Offset(i, 0) = Worksheets(4).Range("B3") 

虽然box1array大于0，但是分割的第二部分不是这样，它再次抛出一个错误。 我试过了，

 If Len(Join(Box1Array(1))) > 0 Then If Box1Array(1) = 1 Then Range("I5").Offset(i, 0) = Worksheets(4).Range("B3") 

但它不是那样的。

谢谢

伊恩

Answer 1

1，如果单元格中没有任何东西分裂，则抛出一个错误

当然，它会抛出下标超出范围的错误，因为你没有分割任何东西，因此没有使用数组元素

你也没有指定分隔符分割…..

 Box1 = Cells(6, "B").Value Box1Array = Split(Box1, "?") 'Replace Question Mark with delimiter. 'TOOL DESCRIPTION ---------------------------------------- If Box1Array(0) = 1 Then 

为了避免这种情况，使用检查来查看数组元素是否存在。

 if len(join(Box1Array)) > 0 then 

2，我想重复这个过程，每次从工作表1中的最后3个单元格向下重复这个过程，但保持相同的参数在工作表4中读取，我试着用偏移量循环它，但是如果单元格中没有任何东西那么它会抛出一个错误。

而不是If else使用Select Case Box1Array(0)来正确地构build你的代码。

Answer 2

只是看你的代码…

 Sub toolsheet() 'START box 1----------------------------------------- Dim Box1Array() As String If Not Len(Cells(6, "B").Value) Then Exit Sub Box1Array = Split(Cells(6, "B").Value, " ") 'TOOL DESCRIPTION ---------------------------------------- Box1Array(0) = Int(Box1Array(0)) If Box1Array(0) >= 1 And Box1Array(0) <= 16 Then Worksheets(1).Range("C7").Value = Worksheets(4).Cells(Box1Array(0) + 2, "G").Value Worksheets(1).Range("B7") = Box1Array(0) End If End Sub 

应该这样做……如果有这样一个逻辑顺序，就不需要把整个过程分开;）

Answer 3

很难理解你的目标

可能这可能是你以后的事情：

 Option Explicit Sub toolsheet() Dim sht1 As Worksheet, sht4 As Worksheet '<~~ declare your worksheet variables Dim i As Long '<~~ declare loop counter Set sht1 = Worksheets("Tool") '<~~ set "tool" worksheet; change "Tool" with the actual name of your "Tool" worksheet Set sht4 = Worksheets("Parameter") '<~~ set "parameter" worksheet, change "Parameter" with actual name of your "parameter" worksheet With sht1.Cells(6, "B") '<~~ take cell "B6" of "tool" sheet as reference cell For i = 1 To 16 '<~~ loop 16 times With .Offset((i - 1) * 3) '<~~ at every loop after the first, offset cell 3 cells down from reference cell If Len(WorksheetFunction.Trim(.Value)) <> 0 Then .Offset(1).Resize(, 2) = Array(sht4.Range("G3").Offset(Split(.Value)(0)), Split(.Value)(0)) '<~~ if the loop current cell isn't blank then make the values copy in the range one row down from current cell and two columns wide End With Next i End With End Sub