EXCEL TOOLS
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
[code]
และปิดด้วย [/code]
ตัวอย่างเช่น [code]dim r as range[/code]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)Code: Select all
Sub MainBOM()
MsgBox "INPUT DATA NOW!!"
Dim mybook As Workbook
Dim i As Long
Dim dbbook As Workbook
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set mybook = ThisWorkbook
If mybook.Sheets("MainBOM").Range("W3").Value = "SX3000ec" Then
Set dbbook = Workbooks.Open("\\Lbox\meeting\EDS\New EDS\Confirm Spec\SX3000 ec\EDS_BOM LIST SX3000 ec.xlsx", UpdateLinks:=False, ReadOnly:=True)
mybook.Sheets("MainBOM").Range("A11:U500").ClearContents
For i = 4 To 60000
If dbbook.Sheets("BOM List").Range("B" & i).Value = mybook.Sheets("MainBOM").Range("N2").Value Then
dbbook.Sheets("BOM List").Range("K" & i, "L" & i).Copy
mybook.Sheets("MainBOM").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("N" & i, "T" & i).Copy
mybook.Sheets("MainBOM").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("W" & i, "Z" & i).Copy
mybook.Sheets("MainBOM").Range("J" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("AB" & i).Copy
mybook.Sheets("MainBOM").Range("N" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("AF" & i, "AL" & i).Copy
mybook.Sheets("MainBOM").Range("O" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("AO" & i).Copy
mybook.Sheets("MainBOM").Range("V" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
End If
Next i
dbbook.Close
End If
Set dbbook = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual
End Sub
Code: Select all
For i = 4 To 60000
If dbbook.Sheets("BOM List").Range("B" & i).Value = mybook.Sheets("MainBOM").Range("N2").Value Then
dbbook.Sheets("BOM List").Range("K" & i, "L" & i).Copy
mybook.Sheets("MainBOM").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("N" & i, "T" & i).Copy
mybook.Sheets("MainBOM").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("W" & i, "Z" & i).Copy
mybook.Sheets("MainBOM").Range("J" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("AB" & i).Copy
mybook.Sheets("MainBOM").Range("N" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("AF" & i, "AL" & i).Copy
mybook.Sheets("MainBOM").Range("O" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("AO" & i).Copy
mybook.Sheets("MainBOM").Range("V" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
End If
Code: Select all
'Other code...
Dim l As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set mybook = ThisWorkbook
If mybook.Sheets("MainBOM").Range("W3").Value = "SX3000ec" Then
Set dbbook = Workbooks.Open("\\Lbox\meeting\EDS\New EDS\Confirm Spec\SX3000 ec\EDS_BOM LIST SX3000 ec.xlsx", UpdateLinks:=False, ReadOnly:=True)
mybook.Sheets("MainBOM").Range("A11:U500").ClearContents
For i = 4 To 60000
With dbbook.Sheets("MainBom")
If dbbook.Sheets("BOM List").Range("B" & i).Value = .Range("N2").Value Then
l = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
dbbook.Sheets("BOM List").Range("K" & i, "L" & i).Copy
.Range("A" & l).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("N" & i, "T" & i).Copy
.Range("C" & l).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("W" & i, "Z" & i).Copy
.Range("J" & l).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("AB" & i).Copy
.Range("N" & l).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("AF" & i, "AL" & i).Copy
.Range("O" & l).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("AO" & i).Copy
.Range("V" & l).PasteSpecial xlPasteValuesAndNumberFormats
End If
End With
Next i
dbbook.Close
'Other code...
Code: Select all
Sub MainBOM()
MsgBox "INPUT DATA NOW!!"
Dim mybook As Workbook
Dim i As Long
Dim dbbook As Workbook
Dim l As Long
Dim aRs As Variant, aTg As Variant
Dim rAll As Range, r As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set mybook = ThisWorkbook
aRs = VBA.Split("K,L,N,O,P,Q,R,S,T,W,X,Y,Z,AB,AF,AH,AI,AJ,AK,AL,AO", ",")
aTg = VBA.Split("A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V", ",")
If mybook.Sheets("MainBOM").Range("W3").Value = "SX3000ec" Then
Set dbbook = Workbooks.Open("C:\Users\Lenovo\Desktop\EDS_BOM LIST SX3000 ec.xlsx", UpdateLinks:=False, ReadOnly:=True)
mybook.Sheets("MainBOM").Range("A11:U500").ClearContents
With dbbook.Worksheets("BOM List")
Set rAll = .Range("b4", .Range("b" & .Rows.Count).End(xlUp))
End With
With mybook.Sheets("MainBom")
For Each r In rAll
If r.Value = .Range("n2").Value Then
l = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Row
For i = 0 To UBound(aRs)
.Range(aTg(i) & l).Value = r.Parent.Cells(r.Row, aRs(i)).Value
Next i
End If
Next r
End With
dbbook.Close
End If
Set dbbook = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual
End Sub