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]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)สำหรับค่านี้เราใช้เป็นเงื่อนไขในการ Delete หรือ Update อยู่แล้วครับ แต่สิ่งที่จะต้องตรวจสอบให้แน่ใจคือ Update หรือ Delete ได้ถูกบรรทัดหรือไม่ มีอะไรเป็นตัวบอกว่าจะ Update หรือ Delete บรรทัดนั้น ๆ เพราะ OI เป็นตัวเดียวกัน คำว่า Delete หรือ Update กับ OI จึงไม่เพียงพอที่จะบอกสิ่งเหล่านั้นกรณีมีข้อมูลจำนวนมากและสลับกันไปสลับกันมา ผมปรับ Code ให้ดู Product Code เพิ่มเข้ามาด้วยว่าต้องเป็น Product เดียวกันถึงค่อย Delete หรือ Updatesu019 wrote:หากเราใช่้ Column L เป็นตัวบอกว่าจะลบ หรือแก้ไข จะได้ไหมค่ะ
Code: Select all
Sub UpdateData2()
Dim rsAll As Range, rtAll As Range
Dim rs As Range, i As Integer
With Worksheets("Print_OI2")
Set rsAll = .Range("G6", .Range("G" & Rows.Count).End(xlUp))
End With
With Worksheets("Database")
Set rtAll = .Range("G2", .Range("G" & Rows.Count).End(xlUp))
End With
For Each rs In rsAll
For i = rtAll.Count To 1 Step -1
If rs = rtAll(i) And rs.Offset(0, -4) = rtAll(i).Offset(0, -4) _
And rs.Offset(0, 6) = "Update" Then
rs.Offset(0, -5).Resize(1, 9).Copy
rtAll(i).Offset(0, -5).PasteSpecial xlPasteValues
End If
Next i
Next rs
Application.CutCopyMode = False
End Sub
Sub DeleteData2()
Dim rsAll As Range, rtAll As Range
Dim rs As Range, i As Integer
With Worksheets("Print_OI2")
Set rsAll = .Range("G6", .Range("G" & Rows.Count).End(xlUp))
End With
With Worksheets("Database")
Set rtAll = .Range("G2", .Range("G" & Rows.Count).End(xlUp))
End With
For Each rs In rsAll
For i = rtAll.Count To 1 Step -1
If rs = rtAll(i) And rs.Offset(0, -4) = rtAll(i).Offset(0, -4) _
And rs.Offset(0, 6) = "Delete" Then
rtAll(i).EntireRow.Delete
End If
Next i
Next rs
End Sub
Code: Select all
Sub test()
Application.Calculation = xlCalculationManual
UpdateData2
Application.Calculation = xlCalculationAutomatic
End Sub
Code: Select all
Sub UpdateData2()
Dim rsAll As Range, rtAll As Range
Dim rs As Range, i As Integer
Application.Calculation = xlCalculationManual
'Ohter code
Application.Calculation = xlCalculationAutomatic
End Sub
สามารถใช้su019 wrote:หากตอนคำนวณ เราไม่อยากให้เห็นข้อมูลตอนที่ระบบกำลังลบ หรือ Update ข้อมูลจะได้ไหมค่ะ
Code: Select all
Application.ScreenUpdating = False
Code: Select all
Application.ScreenUpdating = True
สามารถเขียน Code ให้วางค่าที่ต้องการใน Form ที่เรียกดูข้อมูลหลังจาก Delete หรือ Update แล้วแทนการคียเข้าไปเองครับsu019 wrote:เมื่อคำนวณเสร็จแล้ว ให้ Active ค่าให้ด้วยได้ไหมค่ะ เช่น หลังจากลบบางรายการแล้ว คงเหลือกี่รายการ โดยที่เราไม่ต้องมาใส่ค่า OI ใหม่นะค่ะ
ไม่เข้าใจครับ จะเพิ่มตรงไหน อย่างไร ช่วยอธิบายเพิ่มด้วยครับsu019 wrote:และขอถามเพิ่มเติมนะค่ะ หากเราจะเพิ่ม Option Add อีกข้อนึง เพื่อที่เราจะเพิ่มข้อมูลเข้าไปจะได้ไหมค่ะอาจารย์
Code: Select all
Option Explicit
Const Database = "Database"
Const wh_col = 2
Const prodcode_col = 3
Const prodname_col = 4
Const um_col = 5
Const Lot_col = 6
Const OI_col = 7
Const QtyCtn_col = 8
Const QtyEach_col = 9
Const Palate_col = 10
Const remark_col = 11
Public Sub entry_mode()
Dim blank_row As Single
blank_row = Worksheets(Database).Cells(1, 2).End(xlDown).Row + 1
With Worksheets(Database)
.Cells(blank_row, wh_col).Value = entry_form.WH_txtbox.Value
.Cells(blank_row, prodcode_col).Value = entry_form.prodcode_txtbox.Value
.Cells(blank_row, prodname_col).Value = entry_form.prodname_txtbox.Value
.Cells(blank_row, um_col).Value = entry_form.um_txtbox.Value
.Cells(blank_row, OI_col).Value = entry_form.OI_txtbox.Value
.Cells(blank_row, Lot_col).Value = entry_form.Lot_txtbox.Value
.Cells(blank_row, QtyCtn_col).Value = entry_form.qtyctn_txtbox.Value
.Cells(blank_row, QtyEach_col).Value = entry_form.qtyeach_txtbox.Value
.Cells(blank_row, Palate_col).Value = entry_form.palate_txtbox.Value
.Cells(blank_row, remark_col).Value = entry_form.remark_txtbox.Value
'.Cells(blank_row, remark_col).Value = entry_form.remark_cbbox.Value
End With
MsgBox "Database updated", vbInformation, "Add Stock Item Record"
End Sub
Code: Select all
Sub F5PasteBottom()
Application.Goto Reference:="Source"
Selection.Copy
Application.Goto Reference:="Target"
ActiveSheet.Paste
End Sub
Code: Select all
Sub UpdateData2()
Application.ScreenUpdating = False
Dim rsAll As Range, rtAll As Range
Dim rs As Range, i As Integer
With Worksheets("Update_Delete_Item")
Set rsAll = .Range("G6", .Range("G" & Rows.Count).End(xlUp))
End With
With Worksheets("Database")
Set rtAll = .Range("G2", .Range("G" & Rows.Count).End(xlUp))
End With
For Each rs In rsAll
For i = rtAll.Count To 1 Step -1
If rs = rtAll(i) And rs.Offset(0, -4) = rtAll(i).Offset(0, -4) _
And rs.Offset(0, 6) = "Update" Then
rs.Offset(0, -5).Resize(1, 10).Copy
rtAll(i).Offset(0, -5).PasteSpecial xlPasteValues
End If
Next i
Next rs
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Code: Select all
With Worksheets("Update_Delete_Item")
Set rsAll = .Range("G6", .Range("G" & Rows.Count).End(xlUp))
End With
Code: Select all
Set rtAll = .Range("G2", .Range("G" & Rows.Count).End(xlUp))
Code: Select all
For Each rs In rsAll
For i = rtAll.Count To 1 Step -1
If rs = rtAll(i) And rs.Offset(0, -4) = rtAll(i).Offset(0, -4) _
And rs.Offset(0, 6) = "Update" Then
rs.Offset(0, -5).Resize(1, 10).Copy
rtAll(i).Offset(0, -5).PasteSpecial xlPasteValues
End If
Next i
Next rs
Code: Select all
For i = rtAll.Count To 1 Step -1
If rs = rtAll(i) And rs.Offset(0, -4) = rtAll(i).Offset(0, -4) _
And rs.Offset(0, 6) = "Update" Then
rs.Offset(0, -5).Resize(1, 10).Copy
rtAll(i).Offset(0, -5).PasteSpecial xlPasteValues
End If
Next i
Code: Select all
If rs = rtAll(i) And rs.Offset(0, -4) = rtAll(i).Offset(0, -4) _
And rs.Offset(0, 6) = "Update" Then
rs.Offset(0, -5).Resize(1, 10).Copy
rtAll(i).Offset(0, -5).PasteSpecial xlPasteValues
End If
Code: Select all
Sub UpdateData2()
Application.ScreenUpdating = False
Dim rsAll As Range, rtAll As Range
Dim rs As Range, i As Integer
With Worksheets("Update_Delete_Item")
Set rsAll = .Range("H6", .Range("H" & Rows.Count).End(xlUp))
End With
With Worksheets("Database")
Set rtAll = .Range("H2", .Range("H" & Rows.Count).End(xlUp))
End With
For Each rs In rsAll
For i = rtAll.Count To 1 Step -1
'ไม่เข้าใจตรงนี้นะค่ะ
If rs = rtAll(i) And rs.Offset(0, -4) = rtAll(i).Offset(0, -4) _
And rs.Offset(0, 6) = "Update" Then '6
rs.Offset(0, -6).Resize(1, 11).Copy '-5
rtAll(i).Offset(0, -6).PasteSpecial xlPasteValues
End If
Next i
Next rs
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub