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 r.Offset(0, 1).Value2 >= s(1).Value2 And r.Offset(0, 1).Value2 <= s(2).Value2 Then
arr(i, 0) = i + 1
arr(i, 1) = r.Offset(0, 1).Value
arr(i, 2) = r.Offset(0, 5).Value
arr(i, 3) = r.Offset(0, 7).Value
arr(i, 4) = r.Offset(0, 8).Value
arr(i, 5) = r.Offset(0, 24).Value
arr(i, 6) = r.Offset(0, 25).Value
i = i + 1
End If
Code: Select all
Sub SearchMultipleSheets()
Dim arr(999, 9) As Variant, r As Range
Dim ws As Worksheet, i As Integer, s As Range
With Sheets("รายงาน")
Set s = Sheets("ค้นหา").Range("a4:b4")
.Range("b3").Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
End With
For Each ws In Worksheets
If ws.Name = "กรองข้อมูล" Then
With ws
For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
If r.Offset(0, 5).Value <> r.Offset(-1, 5).Value Then
'If r.Offset(0, 1).Value2 = s.Value2 Then
'arr(i, 0) = i
If r.Offset(0, 1).Value2 >= s(1).Value2 And r.Offset(0, 1).Value2 <= s(2).Value2 Then
arr(i, 0) = i + 1
arr(i, 1) = r.Offset(0, 1).Value
arr(i, 2) = r.Offset(0, 5).Value
arr(i, 3) = r.Offset(0, 7).Value
arr(i, 4) = r.Offset(0, 8).Value
arr(i, 6) = r.Offset(0, 24).Value
arr(i, 7) = r.Offset(0, 25).Value
i = i + 1
End If
End If
Next r
End With
End If
Next ws
With Sheets("รายงาน")
If i > 0 Then
.Range("b3").Resize(i, 8).Value = arr
End If
End With
Range("g3:g" & Range("i5000").End(xlUp).Row).Formula = "=IF(i3="""","""",SUM(i3-h3))"
Range("g3:g" & Range("b5000").End(xlUp).Row).Select
Selection.Copy
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
Code: Select all
With Sheets("รายงาน")
If i > 0 Then
.Range("a3").Resize(i, 8).Value = arr
End If
End With