我是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")
但它不喜欢那样。
由于
伊恩
答案 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