Page 1 of 1

VBA ไม่รัน

Posted: Fri Nov 25, 2022 4:34 pm
by Chutipat_zee
คือว่าถ้า run แยก sub code จะ run ได้ปกติ แต่พอ run แบบหลายๆ sub code ก็จะ run ไม่ได้ค่ะ ในcode ก็ไม่ได้แสดง error อะไรเลย
Sub S12_lookup_Location()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim i, j, XX, Row_pivot1, Row_pivot2, Row_picklist As Long
Row_pivot1 = Sheets("ห้ามลบ").Cells(5, 2)
Row_pivot2 = Sheets("ห้ามลบ").Cells(6, 2)
Row_picklist = Sheets("ห้ามลบ").Cells(8, 2)
On Error Resume Next
For i = 1 To Row_picklist
If Sheets("Picklist").Cells(i, 11).Value = "Defective" Or Sheets("Picklist").Cells(i, 11).Value = "Damaged" Then
If Sheets("Picklist").Cells(i, 6).Value <> " " And (Application.WorksheetFunction.Match(Sheets("Picklist").Cells(i, 6).Value, Sheets("Pivot_copy").Range("J:J"), 0)) Then
XX = Application.WorksheetFunction.Match(Sheets("Picklist").Cells(i, 6).Value, Sheets("Pivot_copy").Range("J:J"), 0)

For j = 0 To Row_pivot2
If Application.WorksheetFunction.Index(Sheets("Pivot_copy").Range("J:P"), XX + j, 1) = Sheets("picklist").Cells(i, 6) And Application.WorksheetFunction.Index(Sheets("Pivot_copy").Range("J:P"), XX + j, 6) >= Sheets("picklist").Cells(i, 10) Then
Sheets("picklist").Cells(i, 7).Value = Sheets("Pivot_copy").Cells(XX + j, 16)
Cells(i, 7).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Exit For
End If
Next j
End If
ElseIf Sheets("Picklist").Cells(i, 11).Value <> "Defective" Or Sheets("Picklist").Cells(i, 11).Value <> "Damaged" Then

If Sheets("Picklist").Cells(i, 6).Value <> " " And (Application.WorksheetFunction.Match(Sheets("Picklist").Cells(i, 6).Value, Sheets("Pivot_copy").Range("A:A"), 0)) Then
XX = Application.WorksheetFunction.Match(Sheets("Picklist").Cells(i, 6).Value, Sheets("Pivot_copy").Range("A:A"), 0)

For j = 0 To Row_pivot2
If Application.WorksheetFunction.Index(Sheets("Pivot_copy").Range("A:G"), XX + j, 1) = Sheets("picklist").Cells(i, 6) And Application.WorksheetFunction.Index(Sheets("Pivot_copy").Range("A:G"), XX + j, 6) >= Sheets("picklist").Cells(i, 10) Then
Sheets("picklist").Cells(i, 7).Value = Sheets("Pivot_copy").Cells(XX + j, 7)
Cells(i, 7).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Exit For
End If
Next j
End If

ElseIf Sheets("Picklist").Cells(i, 11).Value = "Defective" Or Sheets("Picklist").Cells(i, 11).Value = "Damaged" Then
If Sheets("Picklist").Cells(i, 6).Value <> " " And (Application.WorksheetFunction.Match(Sheets("Picklist").Cells(i, 6).Value, Sheets("Pivot_copy").Range("K:K"), 0)) Then
XX = Application.WorksheetFunction.Match(Sheets("Picklist").Cells(i, 6).Value, Sheets("Pivot_copy").Range("K:K"), 0)

For j = 0 To Row_pivot2
If Application.WorksheetFunction.Index(Sheets("Pivot_copy").Range("K:P"), XX + j, 1) = Sheets("picklist").Cells(i, 6) And Application.WorksheetFunction.Index(Sheets("Pivot_copy").Range("K:P"), XX + j, 5) >= Sheets("picklist").Cells(i, 10) Then
Sheets("picklist").Cells(i, 7).Value = Sheets("Pivot_copy").Cells(XX + j, 16)
Cells(i, 7).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Exit For
End If
Next j
End If

ElseIf Sheets("Picklist").Cells(i, 11).Value <> "Defective" Or Sheets("Picklist").Cells(i, 11).Value <> "Damaged" Then
If Sheets("Picklist").Cells(i, 6).Value <> " " And (Application.WorksheetFunction.Match(Sheets("Picklist").Cells(i, 6).Value, Sheets("Pivot_copy").Range("B:B"), 0)) Then
XX = Application.WorksheetFunction.Match(Sheets("Picklist").Cells(i, 6).Value, Sheets("Pivot_copy").Range("B:B"), 0)

For j = 0 To Row_pivot2
If Application.WorksheetFunction.Index(Sheets("Pivot_copy").Range("B:G"), XX + j, 1) = Sheets("picklist").Cells(i, 6) And Application.WorksheetFunction.Index(Sheets("Pivot_copy").Range("B:G"), XX + j, 5) >= Sheets("picklist").Cells(i, 10) Then
Sheets("picklist").Cells(i, 7).Value = Sheets("Pivot_copy").Cells(XX + j, 7)
Cells(i, 7).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Exit For
End If
Next j
End If
End If
Next i

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Re: VBA ไม่รัน

Posted: Fri Nov 25, 2022 4:55 pm
by Xcelvba
เรียนผู้ถามกรุณาแนบไฟล์ ตัวอย่าง หรือ ไฟล์ที่เกี่ยวข้องมาด้วยเพื่อง่ายต่อการตอบของเพื่อนๆ สมาชิก ครับ :D