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 MainCode()
Dim formBook As Workbook
Dim wdShare As Workbook
Dim response As Integer
Dim r As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set formBook = ThisWorkbook
Set wdShare = Workbooks.Open("C:\Documents and Settings\Administrator\Desktop\New Folder (2)\Data.xlsx", False, False)
Set r = formBook.Sheets("Form").Range("K1")
If Application.CountIf(wdShare.Sheets("Sheet1").Range("F:F"), r) <> 0 Then
MsgBox "โปรดตรวจสอบเลขที่เอกสารนี้ได้บันทึกแล้ว รายการซ้ำ "
Exit Sub
End If
Call PasteData2
Call PasteData
Call Sort
Call Data_Copy
wdShare.Close True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
เปลี่ยนเป็นsuka wrote:ชีท Template เซลล์ A2:AD ไม่ต้องค่ะ MainCode ควรปรับอย่างไรคะ
Code: Select all
'--Other code
With formBook.Sheets("Form").Range("E2")
If .Value = "เบิกสินค้า" Or .Value = "โอนสินค้า" Then
Call PasteData2
End If
End With
'--Other code
Code: Select all
Sub MainCode()
Dim formBook As Workbook
Dim wdShare As Workbook
Dim response As Integer
Dim r As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set formBook = ThisWorkbook
Set wdShare = Workbooks.Open("C:\Documents and Settings\Administrator\Desktop\New Folder (2)\Data.xlsx", False, False)
Set r = formBook.Sheets("Form").Range("K1")
If Application.CountIf(wdShare.Sheets("Sheet1").Range("F:F"), r) <> 0 Then
MsgBox "โปรดตรวจสอบเลขที่เอกสารนี้ได้บันทึกแล้ว รายการซ้ำ "
Exit Sub
End If
With formBook.Sheets("Form").Range("E2")
If .Value = "เบิกสินค้า" Or .Value = "โอนสินค้า" Then
Call PasteData2
End If
End With
Call PasteData
Call Sort
Call Data_Copy
wdShare.Close True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Code: Select all
'--Other code
If .Value = "เบิกสินค้า" Or .Value = "โอนสินค้า" Then
Call PasteData2
Call PasteData
End If
End With
Call Sort
Call Data_Copy
'--Other code
Code: Select all
Sub MainCode()
Dim formBook As Workbook
Dim wdShare As Workbook
Dim response As Integer
Dim r As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set formBook = ThisWorkbook
Set wdShare = Workbooks.Open("C:\Documents and Settings\Administrator\Desktop\New Folder (2)\Data.xlsx", False, False)
Set r = formBook.Sheets("Form").Range("K1")
If Application.CountIf(wdShare.Sheets("Sheet1").Range("F:F"), r) <> 0 Then
MsgBox "โปรดตรวจสอบเลขที่เอกสารนี้ได้บันทึกแล้ว รายการซ้ำ "
Exit Sub
End If
With formBook.Sheets("Form").Range("E2")
If .Value = "เบิกสินค้า" Or .Value = "โอนสินค้า" Then
Call PasteData2
Call PasteData
End If
End With
Call Sort
Call Data_Copy
wdShare.Close True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
คุณ puriwutpokin ตอบไปให้แล้ว ถ้าไม่ได้อีกผมว่าเงื่อนไขผิดแล้วละครับถ้าชีท Form เซลล์ E2 เป็น เบิกสินค้า หรือ โอนสินค้า ถ้าใช่เข้าเงื่อนไขต้องการให้ Run Coed Call PasteData2 และ Call PasteData ทั้ง 2 โค้ดเลย
Code: Select all
If .Value = "เบิกสินค้า" Or .Value = "โอนสินค้า" Then
Call PasteData2
Call PasteData
Else
Call x
Call y
Call z
End If
Code: Select all
Sub MainCode()
Dim formBook As Workbook
Dim wdShare As Workbook
Dim response As Integer
Dim r As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set formBook = ThisWorkbook
Set wdShare = Workbooks.Open("C:\Documents and Settings\Administrator\Desktop\New Folder (2)\Data.xlsx", False, False)
Set r = formBook.Sheets("Form").Range("K1")
If Application.CountIf(wdShare.Sheets("Sheet1").Range("F:F"), r) <> 0 Then
MsgBox "โปรดตรวจสอบเลขที่เอกสารนี้ได้บันทึกแล้ว รายการซ้ำ "
Exit Sub
End If
With formBook.Sheets("Form").Range("E2")
If .Value = "เบิกสินค้า" Or .Value = "โอนสินค้า" Then
Call PasteData
Else
Call PasteData2
Call PasteData
'Call Sort
Call Data_Copy
End If
End With
wdShare.Close True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
เมื่อได้ครบตามต้องการก็ควรจะมี Code ตามลักษณะที่ตอบ ๆ กันไปคือจะมีลักษณะด้านล่างเป็นอย่างน้อยครับsuka wrote:ขอกวนอีกรอบนะคะ Code นี้ชีท Form เซลล์ E2 ค่าเป็น เบิกสินค้า หรือ โอนสินค้า วางได้ทั้ง Call PasteData และ
Call PasteData2 ได้ครบตามต้องการค่ะ
Code: Select all
If .Value = "เบิกสินค้า" Or .Value = "โอนสินค้า" Then
Call PasteData
Call PasteData2
Else
Call PasteData
End I
หากเป็นไปตามที่อธิบายมา Code จะมีลักษณะตามตัวอย่างด้านบน ตัวอักษรสี่น้ำเงินให้อธิบายมาใหม่ อ่านแล้วไม่เข้าใจครับsuka wrote:ยังติดที่ถ้าชีท Form เซลล์ E2 ค่าเป็น ผลิต หรือ ประกอบ โค้ดก็รันมาทั้ง 2 โค้ดค่ะ ต้องให้รันแต่โค้ด Call PasteData เพียงโค้ดเีดียวค่ะ ปรับการจะติดสลับกันค่ะถัาได้ เบิกสินค้า หรือ โอนสินค้า ก็จะไปติดที่ ผลิต หรือ ประกอบ
ขออนุญาตนะคะ ขอบคุณค่ะ
Code: Select all
With formBook.Sheets("Form").Range("E2")
If .Value = "เบิกสินค้า" Or .Value = "โอนสินค้า" Then
Call PasteData
Call PasteData2
Else
Call PasteData
End If
End With
Code: Select all
With formBook.Sheets("Form").Range("E2")
If .Value = "เบิกสินค้า" Or .Value = "โอนสินค้า" Then
Call PasteData2
Else
Call PasteData
Call PasteData2
End If
End With
If...then...elseif...
มาช่วยได้ ดู Link นี้ประกอบครับ viewtopic.php?style=13&f=3&t=2798Code: Select all
With formBook.Sheets("Form").Range("E2")
If .Value = "ผลิต" Or .Value = "ประกอบ" Then
Call PasteData
Else
Call PasteData2
Call PasteData
End If
End With
Code: Select all
Call MovementData_Copy
Call Data_Copy
Code: Select all
Sub MainCode()
Dim formBook As Workbook
Dim wdShare As Workbook
Dim response As Integer
Dim r As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set formBook = ThisWorkbook
formBook.Sheets("Form").Activate
Call OpenStock
Set wdShare = Workbooks.Open("C:\Documents and Settings\Administrator\Desktop\ProductionData.xlsx", False, False)
Set r = formBook.Sheets("Form").Range("H2")
If Application.CountIf(wdShare.Sheets("Sheet1").Range("F:F"), r) <> 0 Then
MsgBox "โปรดตรวจสอบเลขที่เอกสารนี้ได้บันทึกแล้ว รายการซ้ำ "
Exit Sub
End If
With formBook.Sheets("Form").Range("E2") '<< == วางค่ากลุ่มเอกสาร
If .Value = "โอนสินค้า" Or .Value = "เบิกสินค้า" Then
Call PasteData
Call PasteData2
Call PasteMovementData
Call PasteMovementData2
Else
Call PasteData
Call PasteMovementData
End If
End With
Call MovementSort '<= Code ให้เรียงลำดับวันที่
Call Sort '<= Code ให้เรียงลำดับวันที่
'Call MovementData_Copy
'Call Data_Copy
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Code: Select all
Sub Data_Copy()
Dim rs As Range, rt As Range
Dim wb As Workbook
Dim formBook As Workbook
Set formBook = ThisWorkbook
Set wb = Workbooks("ProductionData.xlsx")
Set rs = Workbooks("ProductionData.xlsx").Sheets(1).Range("a1:y2000")
Set rt = formBook.Sheets("Database").Range("a1")
rs.Copy: rt.PasteSpecial xlPasteValues
Application.Goto reference:="OFFSET(R1C1,COUNTA(C1),0)"
wb.Save
wb.Close False
End Sub
Code: Select all
Sub MovementData_Copy()
Dim wbShare As Workbook
Dim formBook As Workbook
Set formBook = ThisWorkbook
Set wbShare = Workbooks("Stock.xlsx")
With wbShare.Sheets("Movement").Range("A1:P2000").Copy
formBook.Worksheets("MovementCopy").Range("A1").PasteSpecial xlPasteValues
End With
Application.Goto reference:="OFFSET(R1C1,COUNTA(C1),0)"
wbShare.Save
wbShare.Close
End Sub
สร้างตัวแปรขึ้นมาสำหรับการค้นหาว่าบรรทัดสุดท้ายของข้อมูลอยู่ที่บรรทัดใดแล้วค่อยนำตัวแปรนั้นไปใข้ต่อครับsuka wrote:ขอถามปัญหาใหม่ค่ะ Code Copy ข้อมูลทั้งสองโค้ดด้านล่าง ต้องการเขียนให้คัดลอกเท่าจำนวนข้อมูลที่มีควรปรับโค้ดอย่างดีคะ
Code: Select all
dim lstRow as long
With Workbooks("ProductionData.xlsx").Sheets(1)
lstRow = .Range("a" & .rows.count).end(xlup).row
End With
'...Other code
Set rs = Workbooks("ProductionData.xlsx").Sheets(1).Range("a1:y" & lstrow)
'...Other code