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 test()
Dim x As Integer, NumRows As Integer
On Error Resume Next
Application.ScreenUpdating = False
NumRows = Range("C4", Range("C4").End(xlDown)).Rows.Count
Range("C4").Select
For x = 3 To NumRows
If Cells(x, 3).Value = "ECR Approval" Then
Cells(x, 47).Value = Cells(x, 5)
ElseIf Cells(x, 3).Value = "DCN Approval" Then
Cells(x, 47).Value = Cells(x, 5)
ElseIf Cells(x, 3).Value = "Drawing Release" Then
Cells(x, 47).Value = Cells(x, 5)
Else
Cells(x, 47).Value = Cells(x, 3)
End If
Cells(x, 3).Offset(1, 0).Select
'x = x + 1
Next x
Application.ScreenUpdating = True
End Sub
Code: Select all
Sub test()
Dim x As Integer, NumRows As Integer
On Error Resume Next
Application.ScreenUpdating = False
With Sheets("Sheet1")
NumRows = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Rows.Count
NumRows = NumRows + 2
End With
For x = 3 To NumRows
If Cells(x, 3).Value = "ECR Approval" Then
Cells(x, 47).Value = Cells(x, 5)
ElseIf Cells(x, 3).Value = "DCN Approval" Then
Cells(x, 47).Value = Cells(x, 5)
ElseIf Cells(x, 3).Value = "Drawing Release" Then
Cells(x, 47).Value = Cells(x, 5)
Else
Cells(x, 47).Value = Cells(x, 3)
End If
Cells(x, 3).Offset(1, 0).Select
'x = x + 1
Next x
Application.ScreenUpdating = True
End Sub
Code: Select all
Sub test2()
Dim x As Integer, NumRows As Integer
Dim l As Integer
l = Worksheets("Sheet1").range("A3").End(xlDown).Row
On Error Resume Next
Application.ScreenUpdating = False
With Sheets("Sheet1")
NumRows = .range("B3", .range("B" & Rows.Count).End(xlUp)).Rows.Count
NumRows = NumRows + 2
End With
For x = 3 To NumRows
If Cells(x, 3).Value = "ECR Approval" Then
Cells(x, 48).Value = Cells(x, 37)
ElseIf Cells(x, 3).Value = "DCN Approval" Then
Cells(x, 48).Value = Cells(x, 37)
ElseIf Cells(x, 3).Value = "Drawing Release" Then
Cells(x, 48).Value = Cells(x, 37)
ElseIf Cells(x, 37) = "" Then
If Cells(x, 3) = "ECR Approval" Then
Cells(x, 48) = Application.WorksheetFunction.VLookup(Cells(x, 3), range("A3:AK" & l), 33, 0)
End If
Else
Cells(x, 48).Value = Cells(x, 37)
End If
Next x
Application.ScreenUpdating = True
End Sub
Code: Select all
Sub test2()
Dim x As Integer, NumRows As Integer
Dim l As Integer
l = Worksheets("Sheet1").range("A3").End(xlDown).Row
On Error Resume Next
Application.ScreenUpdating = False
With Sheets("Sheet1")
NumRows = .range("B3", .range("B" & Rows.Count).End(xlUp)).Rows.Count
NumRows = NumRows + 2
End With
For x = 3 To NumRows
If Cells(x, 3).Value = "ECR Approval" Then
Cells(x, 48).Value = Cells(x, 37)
ElseIf Cells(x, 3).Value = "DCN Approval" Then
Cells(x, 48).Value = Cells(x, 37)
ElseIf Cells(x, 3).Value = "Drawing Release" Then
Cells(x, 48).Value = Cells(x, 37)
ElseIf Cells(x, 37) = "" Then
If Cells(x, 3) = "ECR Approval" Then
Cells(x, 48) = Application.WorksheetFunction.VLookup(Cells(x, 3), range("C3:AK" & l), 35, 0)
End If
Else
Cells(x, 48).Value = Cells(x, 37)
End If
Next x
Application.ScreenUpdating = True
End Sub
ลองดูโค้ดนี้ครับ ผมงง กับ โค้ดเก่าและคำถามไม่ค่อยเข้าใจครับลองดูละกันครับ ว่าใช่ไหม
Code: Select all
Sub test2()
Dim x As Integer, NumRows As Integer
Dim l As Integer
l = Worksheets("Sheet1").Range("A3").End(xlDown).Row
On Error Resume Next
Application.ScreenUpdating = False
With Sheets("Sheet1")
NumRows = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Rows.Count
NumRows = NumRows + 2
End With
For x = 3 To NumRows
If Cells(x, 3).Value = "ECR Approval" Then
Cells(x, 48).Value = Cells(x, 37)
ElseIf Cells(x, 3).Value = "DCN Approval" Then
Cells(x, 48).Value = Cells(x, 37)
ElseIf Cells(x, 3).Value = "Drawing Release" Then
Cells(x, 48).Value = Cells(x, 37)
' ElseIf Cells(x, 37) = "" Then
' If Cells(x, 3) = "ECR Approval" Then
' Cells(x, 48) = Application.WorksheetFunction.VLookup(Cells(x, 3), Range("C3:AK" & l), 35, 0)
' End If
' Else
' Cells(x, 48).Value = Cells(x, 37)
End If
Next x
Application.ScreenUpdating = True
End Sub
ใช่ค่ะ ECR NO เดียวกันจะมีวันที่เดียวกันค่ะ
Code: Select all
Sub test2()
Dim x As Integer, NumRows As Integer
Dim l As Integer
l = Worksheets("Sheet1").Range("A3").End(xlDown).Row
On Error Resume Next
Application.ScreenUpdating = False
With Sheets("Sheet1")
NumRows = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Rows.Count
NumRows = NumRows + 2
End With
For x = 3 To NumRows
If Cells(x, 3).Value = "ECR Approval" Then
Cells(x, 48).Value = Cells(x, 37)
ElseIf Cells(x, 3).Value = "DCN Approval" Then
Cells(x, 48).Value = Cells(x, 37)
ElseIf Cells(x, 3).Value = "Drawing Release" Then
Cells(x, 48).Value = Cells(x, 37)
ElseIf Cells(x, 3) <> "" And Cells(x, 37) = "" Then
Cells(x, 48).Select
Selection.FillDown
End If
Next x
Application.ScreenUpdating = True
End Sub
Code: Select all
Sub test()
Dim x As Integer, NumRows As Integer
Dim l As Integer
On Error Resume Next
Application.ScreenUpdating = False
With Sheets("Sheet1")
NumRows = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Rows.Count
NumRows = NumRows + 2
End With
For x = 3 To NumRows
If Cells(x, 3).Value = "ECR Approval" Then
Cells(x, 47).Value = Cells(x, 5)
ElseIf Cells(x, 3).Value = "DCN Approval" Then
Cells(x, 47).Value = Cells(x, 5)
ElseIf Cells(x, 3).Value = "Drawing Release" Then
Cells(x, 47).Value = Cells(x, 5)
Else
Cells(x, 47).Value = Cells(x, 3)
End If
Cells(x, 3).Offset(1, 0).Select
'x = x + 1
Next x
l = Worksheets("Sheet1").Range("A2").End(xlDown).Row
For x = 3 To NumRows
With ActiveSheet
.Cells(x, 48).Value = Application.IfError(Application.VLookup(.Cells(x, 47).Value, .Range("E:AK"), 33, 0), "")
End With
Next x
Application.ScreenUpdating = True
End Sub
Code: Select all
Sub test3()
Dim x As Integer, NumRows As Integer
On Error Resume Next
Application.ScreenUpdating = False
With Sheets("Sheet1")
NumRows = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Rows.Count
NumRows = NumRows + 2
End With
For x = 3 To NumRows
If Cells(x, 3).Value = "ECR Approval" Then
Cells(x, 47).Value = Cells(x, 5)
Cells(x, 48).Value = Cells(x, 37)
Cells(x, 48).Offset(1, 0).FillDown
ElseIf Cells(x, 3).Value = "DCN Approval" Then
Cells(x, 47).Value = Cells(x, 5)
Cells(x, 48).Value = Cells(x, 37)
Cells(x, 48).Offset(1, 0).FillDown
ElseIf Cells(x, 3).Value = "Drawing Release" Then
Cells(x, 47).Value = Cells(x, 5)
Cells(x, 48).Value = Cells(x, 37)
Cells(x, 48).Offset(1, 0).FillDown
Else
Cells(x, 47).Value = Cells(x, 3)
If Cells(x, 47).Value <> "" Then
Cells(x, 48).Offset(1, 0).FillDown
Else
Cells(x, 48).Value = ""
End If
End If
Next x
Application.ScreenUpdating = True
End Sub
ขอบคุณมากค่ะpuriwutpokin wrote: ↑Thu Jan 25, 2018 2:33 pm ลองดูครับว่าใช่ไหมCode: Select all
Sub test2() Dim x As Integer, NumRows As Integer Dim l As Integer l = Worksheets("Sheet1").Range("A3").End(xlDown).Row On Error Resume Next Application.ScreenUpdating = False With Sheets("Sheet1") NumRows = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Rows.Count NumRows = NumRows + 2 End With For x = 3 To NumRows If Cells(x, 3).Value = "ECR Approval" Then Cells(x, 48).Value = Cells(x, 37) ElseIf Cells(x, 3).Value = "DCN Approval" Then Cells(x, 48).Value = Cells(x, 37) ElseIf Cells(x, 3).Value = "Drawing Release" Then Cells(x, 48).Value = Cells(x, 37) ElseIf Cells(x, 3) <> "" And Cells(x, 37) = "" Then Cells(x, 48).Select Selection.FillDown End If Next x Application.ScreenUpdating = True End Sub
โอเคค่ะ ขอบคุณมากค่ะeyepop99 wrote: ↑Thu Jan 25, 2018 5:02 pm ปรับตามนี้นะครับ น่าจะใช้ได้แล้ว ผมลองรันแล้ว ผ่าน
ปล. item ที่ 25และ26 ผลลัพธ์ไม่เหมือนตัวอย่างที่ให้มา เพราะว่า ERC NO นั้น VLOOKUp ตรวจพบ เท่ากับวันที่ 16-jan-18 เป็นตัวแรก
จะได้ผลลัพธ์เท่ากับ 16-jan-18
แต่ตัวอย่างผลลัพธ์ที่ได้ จะเท่ากับ 4-Jan-18
Code: Select all
Sub test() Dim x As Integer, NumRows As Integer Dim l As Integer On Error Resume Next Application.ScreenUpdating = False With Sheets("Sheet1") NumRows = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Rows.Count NumRows = NumRows + 2 End With For x = 3 To NumRows If Cells(x, 3).Value = "ECR Approval" Then Cells(x, 47).Value = Cells(x, 5) ElseIf Cells(x, 3).Value = "DCN Approval" Then Cells(x, 47).Value = Cells(x, 5) ElseIf Cells(x, 3).Value = "Drawing Release" Then Cells(x, 47).Value = Cells(x, 5) Else Cells(x, 47).Value = Cells(x, 3) End If Cells(x, 3).Offset(1, 0).Select 'x = x + 1 Next x l = Worksheets("Sheet1").Range("A2").End(xlDown).Row For x = 3 To NumRows With ActiveSheet .Cells(x, 48).Value = Application.IfError(Application.VLookup(.Cells(x, 47).Value, .Range("E:AK"), 33, 0), "") End With Next x Application.ScreenUpdating = True End Sub
ขอบคุณมากค่ะpuriwutpokin wrote: ↑Thu Jan 25, 2018 7:39 pm แก้ปัญหา Vlookup โดยวิธีนี้ดูครับCode: Select all
Sub test3() Dim x As Integer, NumRows As Integer On Error Resume Next Application.ScreenUpdating = False With Sheets("Sheet1") NumRows = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Rows.Count NumRows = NumRows + 2 End With For x = 3 To NumRows If Cells(x, 3).Value = "ECR Approval" Then Cells(x, 47).Value = Cells(x, 5) Cells(x, 48).Value = Cells(x, 37) Cells(x, 48).Offset(1, 0).FillDown ElseIf Cells(x, 3).Value = "DCN Approval" Then Cells(x, 47).Value = Cells(x, 5) Cells(x, 48).Value = Cells(x, 37) Cells(x, 48).Offset(1, 0).FillDown ElseIf Cells(x, 3).Value = "Drawing Release" Then Cells(x, 47).Value = Cells(x, 5) Cells(x, 48).Value = Cells(x, 37) Cells(x, 48).Offset(1, 0).FillDown Else Cells(x, 47).Value = Cells(x, 3) If Cells(x, 47).Value <> "" Then Cells(x, 48).Offset(1, 0).FillDown Else Cells(x, 48).Value = "" End If End If Next x Application.ScreenUpdating = True End Sub