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
If OptionButton13.Value = True And OptionButton8.Value = True And TextBox11.Value = "" And TextBox14.Value = "" And TextBox12.Value <> "" And TextBox13.Value <> "" Then 'ตามวงเงินคงเหลือ
On Error Resume Next
With Workbooks("CIM.xlsm").Worksheets("LN001")
Set ri = .Range(.Range("A1"), .Range("AD65536") _
.End(xlUp)).SpecialCells(xlCellTypeVisible)
End With
With Workbooks("CIM.xlsm").Worksheets("Report")
Set ry = Workbooks("CIM.xlsm").Worksheets("Report").Range("A1")
End With
Sheet6.Activate
cri = TextBox12.Value
crx = TextBox13.Value
Sheet6.Activate
ActiveSheet.Range("A:AD").AutoFilter Field:=16, Criteria1:=">" & cri, _
Operator:=xlAnd, Criteria2:="<=" & crx
ri.Select
ri.Copy: ry.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheet6.Activate
Sheet6.ShowAllData
Sheet17.Activate
Sheet17.Range("CA1").Formula = "=COUNTA(A:A)-1"
TextBox6.Value = Sheet17.Range("CA1").Value
Sheet17.Range("CA2").Formula = "=SUM(P:P)"
TextBox7.Value = Sheet17.Range("CA2").Value
Sheet17.Activate
Sheet17.Range("A1").Value = "CIF"
Sheet17.Range("B1").Value = "ID"
Columns("A:N").Select
Selection.EntireColumn.AutoFit
MsgBox "เรียกรายงานสำเร็จ", vbOKOnly, "CIM 360"
End If
Code: Select all
Sheet6.Activate
Range("A:A").Select
Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"AG:AG"), Unique:=True
With Workbooks("CIM.xlsm").Worksheets("Cimx")’sheet 6
r = 2
Do Until Sheet6.Cells(r, 33).Value = ""
Sheet6.Cells(r, 34).Formula = [u]"=SUMIF(A:A," & Sheet6.Cells(r, 33).Address & ",B:B)" 'สูตรนี้ไม่ทราบเขียนถูกหรือไม่[/u]
r = r + 1
frmcalculator.TextBox1.Value = r - 2
DoEvents
Loop
End With
Sheet10.Range(A:A).value = Sheet6.Range(AG:AG).value 'รหัสลูกค้าที่ไม่ซ้ำ
Sheet10.Range(B:B).value = Sheet6.Range(AH:AH).value 'หนี้รวม
ขั้นตอนการค้นหาเพื่อให้ได้รหัสลูกค้าตามที่ช่วงจำนวนเงินที่กำหนด
On Error Resume Next
With Workbooks("CIM.xlsm").Worksheets("LN002")
Set ri = .Range(.Range("A1"), .Range("AD65536") _
.End(xlUp)).SpecialCells(xlCellTypeVisible)
End With
With Workbooks("CIM.xlsm").Worksheets("transfer")
Set ry = Workbooks("CIM.xlsm").Worksheets("transfer").Range("A1")
End With
Sheet10.Activate
cri = TextBox23.Value
crx = TextBox24.Value
Sheet10.Activate
ActiveSheet.Range("A:B").AutoFilter Field:=2, Criteria1:=">" & cri, _
Operator:=xlAnd, Criteria2:="<=" & crx
ri.Select
ri.Copy: ry.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheet10.Activate
Sheet10.ShowAllData
ขั้นตอนนำรหัสที่ต่างกันไปค้นหาจากหน้าข้อมูลหนี้คงเหลืออีกครั้งหนึ่ง
On Error Resume Next
With Workbooks("CIM.xlsm").Worksheets("LN001")
Set ri = .Range(.Range("A1"), .Range("AD65536") _
.End(xlUp)).SpecialCells(xlCellTypeVisible)
End With
With Workbooks("CIM.xlsm").Worksheets("Report")
Set ry = Workbooks("CIM.xlsm").Worksheets("Report").Range("A1")
End With
Sheet6.Activate
cri = Sheet11.Range(A:A).value [u]'ข้อมูลรหัสลุกค้าที่ต่างกันจาก Sheet transfer ไม่ทราบว่าสามารถกำหนดเงื่อนไขเป็นช่วงข้อมูลอย่างนี้ได้มั๊ย[/u]
Sheet6.Activate
ActiveSheet.Range("A:AD").AutoFilter Field:=13, Criteria1:= cri [u] อันนี้ก็ให้คัดกรองตามเงื่อนไขไม่ทราบระบุถูกหรือไม่[/u]
ri.Select
ri.Copy: ry.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheet10.Activate
Sheet10.ShowAllData
Code: Select all
Private Sub CommandButton18_Click()
Dim ry As Range
Dim ri As Range
Dim ro As Range
Dim rx As Range
Dim cra As Range
Dim cri As String
Dim crx As String
Dim cro As String
Dim cry As String
If frmloan.OptionButton31.Value = False And frmloan.OptionButton30.Value = False Then
MsgBox "โปรดเลือกเงื่อนไขตามวงเงินกู้หรือหนี้คงเหลือ", vbOKOnly, "CIM 360"
Exit Sub
End If
If frmloan.TextBox27.Value = "" And frmloan.TextBox28.Value = "" Then
MsgBox "โปรดระบุจำนวนเงินตามที่ต้องการ", vbOKOnly, "CIM 360"
Exit Sub
End If
Application.ScreenUpdating = False
Sheet17.Range("A:BZ").Value = ""
frmloan.TextBox32.Text = ""
frmloan.TextBox33.Text = ""
frmloan.TextBox36.Text = ""
Sheet26.Range("A:C").Value = ""
Sheet10.Range("Z98").Value = "FILE B"
'หนี้รายคนตามวงเงิน
If frmloan.OptionButton31.Value = True And frmloan.OptionButton30.Value = False And frmloan.TextBox35.Value = "" And frmloan.TextBox27.Value <> "" And frmloan.TextBox28.Value = "" Then
'การค้นหาตามวงเงินกู้รายคน
On Error Resume Next
With Workbooks("CIM.xlsm").Worksheets("transfer")
Set ri = .Range(.Range("A1"), .Range("C80000") _
.End(xlUp)).SpecialCells(xlCellTypeVisible)
End With
With Workbooks("CIM.xlsm").Worksheets("LN001")
Set ro = .Range(.Range("A1"), .Range("AF80000") _
.End(xlUp)).SpecialCells(xlCellTypeVisible)
End With
With Workbooks("CIM.xlsm").Worksheets("Rest")
Set rx = Workbooks("CIM.xlsm").Worksheets("Rest").Range("A1")
End With
With Workbooks("CIM.xlsm").Worksheets("Report")
Set ry = Workbooks("CIM.xlsm").Worksheets("Report").Range("A1")
End With
Sheet25.Activate
cri = TextBox27.Value
Sheet25.Activate
Sheet25.Range("A:C").AutoFilter
ActiveSheet.Range("A:C").AutoFilter Field:=2, Criteria1:=">=" & cri
ri.Select
ri.Copy: rx.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheet25.Activate
Sheet25.ShowAllData 'ขั้นตอนนี้ทุกอย่างโอเคครับ
Sheet6.Activate 'ขั้นตอนจะนำรหัสลูกค้าที่ได้จากขั้นตอนแรก ข้อมูลอยู่ใน sheet Rest Range("A:A")
cra = Sheet26.Range("A:A").Value 'เมื่อรัน เกิด bug ระบบมองว่า cra ="" ,Nothing
Sheet6.Range("A:AF").AutoFilter
Sheet6.Range("A:AF").AutoFilter Field:=1, Criteria1:=cra 'การกำหนดเงื่อนไขผิด
ro.Select
ro.Copy: ry.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheet6.Activate
Sheet6.ShowAllData
Sheet17.Activate
Sheet17.Range("CA1").Formula = "=COUNTA(A:A)-1"
Sheet17.Range("CA2").Formula = "=SUM(O:O)"
Sheet17.Range("CA3").Formula = "=SUM(IF(FREQUENCY(A:A,A:A)>0,1))"
TextBox32.Value = Sheet17.Range("CA3").Value
TextBox36.Value = Sheet17.Range("CA1").Value
TextBox33.Value = Sheet17.Range("CA2").Value
Sheet17.Activate
Sheet17.Range("A1").Value = "CIF"
Sheet17.Range("B1").Value = "ID"
MsgBox "เรียกรายงานสำเร็จครับ", vbOKOnly, "CIM 360"
End If
If Sheet17.Range("A2").Value = "" Then
MsgBox "ไม่พบรายงานตามเงื่อนไขที่ระบุ", vbOKOnly, "CIM 360"
End If
End Sub
Code: Select all
'Other code
Set cra = Sheet5.Range("A1", Sheet5.Range("A60000").End(xlUp))
Sheet1.Range("A:G").AdvancedFilter Action:=xlFilterInPlace, criteriarange:=cra
'Other code
Code: Select all
Set cra = Sheet5.Range("A1", Sheet5.Range("A60000").End(xlUp))
Code: Select all
Set cra = Sheet5.Range("A1", Sheet5.Range("A60000").End(xlUp)).resize(,2)