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
Private Sub CommandButton1_Click()
Dim rFind As Range, rDataAll As Range
Dim r As Range, rTarget As Range
Dim ws4 As Worksheet, i As Integer
Set ws4 = Worksheets("AIA")
Set rFind = Sheets("Display").Range("I7")
Application.EnableEvents = False
ws4.Range("C12:F1000").ClearContents
If Sheets("Display").Range("I7") = "" Then Exit Sub
With Sheets("Data")
Worksheets("AIA").Range("C21").Resize(1000, 1).EntireRow.Delete
Set rDataAll = .Range("B1", .Range("B" & Rows.Count).End(xlUp))
If .Columns("B:B").Find(rFind, LookIn:=xlValues) Is Nothing Then
MsgBox ("ไม่มี Package นี้")
Exit Sub
End If
End With
i = 12
For Each r In rDataAll
If r = rFind Then
ws4.Range("d" & i).Resize(1, 2).Value = _
r.Offset(0, 1).Resize(1, 2).Value
i = i + 1
End If
Next r
Worksheets("AIA").Range("C49:D49").Value = "Total"
Worksheets("AIA").Range("E49:F49").Formula = "=Sum(R17C:R[-1]C)"
Worksheets("AIA").Range("D12").Resize(600, 1).EntireRow.Insert
With Sheets("AIA")
.Range("d" & i + 2, .Range("d" & i).End(xlDown).Offset(-1, 0)) _
.EntireRow.Delete
End With
Application.EnableEvents = True
' MsgBox "Get data has finished."
Set ws4 = Nothing
Set rFind = Nothing
Set rDataAll = Nothing
End Sub
Code: Select all
Private Sub CommandButton1_Click()
Dim rFind As Range, rDataAll As Range
Dim r As Range, rTarget As Range
Dim ws4 As Worksheet, i As Integer
Set ws4 = Worksheets("AIA")
Set rFind = Sheets("Display").Range("I7")
Application.EnableEvents = False
ws4.Range("C12:F1000").ClearContents
If Sheets("Display").Range("I7") = "" Then Exit Sub
With Sheets("Data")
Worksheets("AIA").Range("C21").Resize(1000, 1).EntireRow.Delete
Set rDataAll = .Range("B1", .Range("B" & Rows.Count).End(xlUp))
If .Columns("B:B").Find(rFind, LookIn:=xlValues) Is Nothing Then
MsgBox ("äÁèÁÕ Package ¹Õé")
Exit Sub
End If
End With
i = 12
For Each r In rDataAll
If r = rFind Then
ws4.Range("d" & i).Resize(1, 2).Value = _
r.Offset(0, 1).Resize(1, 2).Value
If IsNumeric(VBA.Left(ws4.Range("d" & i), 1)) Then
ws4.Range("d" & i).Resize(1, 2).Font.Bold = True
ws4.Range("e" & i).Font.Color = vbRed
End If
i = i + 1
End If
Next r
' Worksheets("AIA").Range("C49:D49").Value = "Total"
'
' Worksheets("AIA").Range("E49:F49").Formula = "=Sum(R17C:R[-1]C)"
' Worksheets("AIA").Range("D12").Resize(600, 1).EntireRow.Insert
With Sheets("AIA")
.Range("c10:f10").Copy
.Range("d" & .Rows.Count).End(xlUp).Offset(3, -1).Resize(1, 4).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
With .Range("D" & .Rows.Count).End(xlUp).Offset(3, 0)
.Offset(0, -1).Value = "Total"
.Offset(0, 1).Formula = "=Sumifs(R11C:R[-1]C,R11C[-1]:R[-1]C[-1],""*.*"")"
' .Range("D12").Resize(600, 1).EntireRow.Insert
' .Range("d" & i + 2, .Range("d" & i).End(xlDown).Offset(-1, 0)) _
.EntireRow.Delete
End With
.Range("e17", .Range("e" & .Rows.Count).End(xlUp)).NumberFormat = "#,##0"
With .Range("e17", .Range("e" & .Rows.Count).End(xlUp)).Offset(0, -2)
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Offset(0, 1).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Offset(0, 3).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
End With
End With
Application.EnableEvents = True
' MsgBox "Get data has finished."
Set ws4 = Nothing
Set rFind = Nothing
Set rDataAll = Nothing
End Sub
Code: Select all
With Sheets("AIA-Detail")
.Range("c10:g11").Copy
.Range("d" & .Rows.Count).End(xlUp).Offset(3, -1).Resize(1, 4).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
With .Range("D" & .Rows.Count).End(xlUp).Offset(3, 0)
.Offset(0, -1).Value = "Total"
.Offset(0, 1).Formula = "=Sumifs(R11C:R[-1]C,R11C[-1]:R[-1]C[-1],""*.*"")"
.EntireRow.Delete
End With
Code: Select all
Private Sub CommandButton1_Click()
Dim rFind As Range, rDataAll As Range
Dim r As Range, rTarget As Range
Dim ws4 As Worksheet, i As Integer
Set ws4 = Worksheets("AIA")
Set ws5 = Worksheets("AIA-Detail")
Set rFind = Sheets("Display").Range("I7")
Application.EnableEvents = False
ws4.Range("C12:F1000").ClearContents
ws5.Range("C13:k1000").ClearContents
If Sheets("Display").Range("I7") = "" Then Exit Sub
With Sheets("Data")
Worksheets("AIA").Range("C21").Resize(1000, 1).EntireRow.Delete
Set rDataAll = .Range("B1", .Range("B" & Rows.Count).End(xlUp))
If .Columns("B:B").Find(rFind, LookIn:=xlValues) Is Nothing Then
MsgBox ("äÁèÁÕ Package ¹Õé")
Exit Sub
End If
End With
i = 12
For Each r In rDataAll
If r = rFind Then
ws4.Range("d" & i).Resize(1, 2).Value = _
r.Offset(0, 1).Resize(1, 2).Value
If IsNumeric(VBA.Left(ws4.Range("d" & i), 1)) Then
ws4.Range("d" & i).Resize(1, 2).Font.Bold = True
ws4.Range("d" & i).Offset(0, -1).Resize(1, 4).Interior.Color = _
ws4.Range("c10").Interior.Color
' ws4.Range("e" & i).Font.Color = vbRed
End If
i = i + 1
End If
Next r
' Worksheets("AIA").Range("C49:D49").Value = "Total"
'
' Worksheets("AIA").Range("E49:F49").Formula = "=Sum(R17C:R[-1]C)"
' Worksheets("AIA").Range("D12").Resize(600, 1).EntireRow.Insert
With Sheets("AIA")
.Range("c10:f10").Copy
.Range("d" & .Rows.Count).End(xlUp).Offset(3, -1).Resize(1, 4).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
With .Range("D" & .Rows.Count).End(xlUp).Offset(3, 0)
.Offset(0, -1).Value = "Total"
.Offset(0, 1).Formula = "=Sumifs(R11C:R[-1]C,R11C[-1]:R[-1]C[-1],""*.*"")"
' .Range("D12").Resize(600, 1).EntireRow.Insert
' .Range("d" & i + 2, .Range("d" & i).End(xlDown).Offset(-1, 0)) _
.EntireRow.Delete
End With
.Range("e17", .Range("e" & .Rows.Count).End(xlUp)).NumberFormat = "#,##0"
With .Range("e17", .Range("e" & .Rows.Count).End(xlUp)).Offset(0, -2)
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Offset(0, 1).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Offset(0, 3).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
End With
End With
'Other Sheet
With Sheets("Datadetail")
Worksheets("AIA-Detail").Range("C21").Resize(1000, 1).EntireRow.Delete
Set rDataAll = .Range("B1", .Range("B" & Rows.Count).End(xlUp))
If .Columns("B:B").Find(rFind, LookIn:=xlValues) Is Nothing Then
MsgBox ("äÁèÁÕ Package ¹Õé")
Exit Sub
End If
End With
i = 13
For Each r In rDataAll
If r = rFind Then
ws5.Range("d" & i).Resize(1, 4).Value = _
r.Offset(0, 1).Resize(1, 4).Value
If IsNumeric(VBA.Left(ws5.Range("d" & i), 1)) Then
ws5.Range("d" & i).Resize(1, 4).Font.Bold = True
ws5.Range("d" & i).Offset(0, -1).Resize(1, 5).Interior.Color = _
ws5.Range("c10").Interior.Color
' ws4.Range("e" & i).Font.Color = vbRed
End If
i = i + 1
End If
Next r
With Sheets("AIA-Detail")
.Range("c10:g11").Copy
.Range("d" & .Rows.Count).End(xlUp).Offset(3, -1).Resize(1, 5).PasteSpecial xlPasteFormats
With .Range("d" & .Rows.Count).End(xlUp).Offset(3, -1)
.Resize(1, 5).PasteSpecial xlPasteFormats
.Offset(0, 1).UnMerge
With .Resize(1, 3)
.Merge
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).Weight = xlMedium
.Offset(0, 1).Resize(1, 2).Merge
End With
End With
Application.CutCopyMode = False
With .Range("D" & .Rows.Count).End(xlUp).Offset(3, 0)
.Offset(0, -1).Value = "Total"
.Offset(0, 1).Formula = "=Sumifs(R11C:R[-1]C,R11C[-2]:R[-1]C[-2],""*.*"")"
' .EntireRow.Delete
End With
.Range("e11", .Range("f" & .Rows.Count).End(xlUp)).NumberFormat = "#,##0"
' .Range("f" & .Rows.Count).End(xlUp).NumberFormat = "#,##0"
With .Range("f17", .Range("f" & .Rows.Count).End(xlUp)).Offset(0, -3)
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Offset(0, 1).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Offset(0, 2).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Offset(0, 4).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
End With
With .Range("f" & .Rows.Count).End(xlUp).Offset(0, -3).Resize(1, 5).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
End With
Application.EnableEvents = True
' MsgBox "Get data has finished."
Set ws4 = Nothing
Set rFind = Nothing
Set rDataAll = Nothing
End Sub
Code: Select all
With Sheets("AIA")
.Range("c10:f10").Copy
.Range("d" & .Rows.Count).End(xlUp).Offset(3, -1).Resize(1, 4).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
With .Range("D" & .Rows.Count).End(xlUp).Offset(3, 0)
.Offset(0, -1).Value = "รวมราคาท้้งหมด " & ws4.Range("L11").Value & " บาท"
End With
With .Range("d12", .Range("d" & .Rows.Count).End(xlUp)).Offset(0, -1)
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Offset(0, 3).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
End With
End With
Code: Select all
'Other code
'With .Range("d12", .Range("d" & .Rows.Count).End(xlUp)).Offset(0, -1)
With .Range("c12", .Range("c" & .Rows.Count).End(xlUp))
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Offset(0, 3).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
End With
With .Range("c" & .Rows.Count).End(xlUp)
.Offset(2, 0).Value = "หมายเหตุ : ราคาดังกล่าวไม่รวมค่าใช้จ่ายดังต่อไปนี้"
.Offset(2, 0).Font.Bold = True
.Offset(3, 0).Value = "* การรักษาโรคประจำตัว"
.Offset(4, 0).Value = "* การรักษาภาวะแทรกซ้อน"
.Offset(5, 0).Value = "* ค่ารักษา ค่าส่งตรวจ"
End With
'Other code
Code: Select all
With
'xyz
End With
If
'xyz
End If
For x = 0 to 10
'xyz
Next x