循环单元格偏移量?

时间:2016-06-11 11:07:22

标签: excel vba excel-vba loops macros

我是VBA的新手我已经做了一些宏来帮助加快车间工作表的自动化流程,所以请原谅任何冗长的代码,但这个让我感到难过。

我们的机器有一个工具表,我希望自动化它,当你在一个单元格中放入一个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,我希望每次从工作表1中的最后一个3个单元格重复此过程16次,但保持相同的参数在工作表4中读取,I我试过用偏移来循环它,但如果单元格中没有任何东西那么它会再次抛出错误。

感谢您的帮助

伊恩

编辑:

感谢您的帮助,我现在已经完成了代码,并且只有在我完美输入信息时才能正常工作。

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

但它不喜欢那样。

由于

伊恩

3 个答案:

答案 0 :(得分: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

应该这样做......如果有这样的逻辑顺序,就没有必要将整个过程分开;)

答案 1 :(得分:0)

  

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,我想重复这个过程16次,每次从工作表1中的最后一个3个单元格下来,但保持相同的参数在工作表4中读取,我尝试用偏移量循环它但是如果那里再次在单元格中没有任何内容然后它会引发错误。

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

答案 2 :(得分:0)

很难理解你的目标

可能是你所追求的:

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