循环单元格偏移

Question

我对VBA很陌生，我已经做了一些宏，通过自动化车间工作表等来帮助加快车间的进程，所以请原谅任何冗长的代码，但这一个让我很困惑。

我们有一个机器的工具表，我想自动化它，当你把一个4位数的代码放在一个单元格中，即"1 4 a V"时，它会用另一个参数工作表中的更详细的描述填写工具表的各个部分，这是代码。

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中保持相同的参数，我尝试过用偏移量循环它，但如果单元格中没有内容，则再次引发错误。

感谢的帮助

Iain

编辑：

感谢您的帮助，我现在已经完成了代码的运行，并且运行得很好，但前提是我必须完美地输入信息。

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")

但它不喜欢这样。

感谢

Iain

Answer 1

只需查看您的代码。。。

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 2

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个单元格中，每次重复这个过程16次，但在工作表4中保持相同的参数，我尝试过用偏移量循环它，但如果单元格中什么都没有，它就会出错。

使用Select Case Box1Array(0)来正确构建代码，而不是If else。

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