Смещение ячейки петли?

Question

Я очень новичок в 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 

У меня есть 2 проблемы. 1, если в ячейке нет ничего, что он расщепляет, он вызывает ошибку и 2, я хочу повторить этот процесс 16 раз каждый раз, когда 3 ячейки опускаются от последнего на листе 1, но сохраняя одни и те же параметры для чтения на листе 4, I «Пробовал перебирать его со смещением, но еще раз, если в ячейке ничего нет, он вызывает ошибку.

Спасибо за любую помощь

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

1, если нет ничего в клетке, что она разделяет его бросает ошибку

Ofcourse он отбросит подстрочный из ошибки диапазона, поскольку вы ничего не разделил и, следовательно, нет элементов массива для использования

Вы также не указали разделитель для разделения ...

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 раз, каждый раз 3 клетки вниз от последнего в листе 1, но сохраняя те же параметры, чтобы читать в таблице 4, я пытался обернув его со смещением, но еще раз, если в ячейке ничего нет, он вызывает ошибку.

Вместо If else используйте Select Case Box1Array(0), чтобы правильно структурировать свой код.

Answer 2

довольно трудно понять, ваша цель

может быть это может быть то, что вы после:

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 

Answer 3

просто глядя на свой код ...

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 

должны сделать то же самое ... нет необходимости разбить весь этот процесс, если существует такой логический порядок;)