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 Button2_Click()
Sheets("sheet2").Select
Range("d5").Copy
Sheets("ÃÇÁÊÃØ»ÂÍ´").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("sheet3").Select
Range("d5").Copy
Sheets("ÃÇÁÊÃØ»ÂÍ´").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("sheet4").Select
Range("d5").Copy
Sheets("ÃÇÁÊÃØ»ÂÍ´").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("sheet5").Select
Range("d5").Copy
Sheets("ÃÇÁÊÃØ»ÂÍ´").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("sheet6").Select
Range("d5").Copy
Sheets("ÃÇÁÊÃØ»ÂÍ´").Select
Range("A6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Code: Select all
Sub Button2_Click()
Dim sh As Worksheet
Worksheets("รวมสรุปยอด").Range("a2:a1000").ClearContents
For Each sh In Worksheets
If sh.Name <> "รวมสรุปยอด" Then
With Worksheets("รวมสรุปยอด")
.Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Value = sh.Range("d5").Value
End With
End If
Next sh
End Sub
Code: Select all
Sub Button2_Click()
Dim sh As Worksheet
Worksheets("รวมสรุปยอด").Range("a2:a1000").ClearContents
For Each sh In Worksheets
If sh.Name <> "รวมสรุปยอด" Then
With Worksheets("รวมสรุปยอด")
.Range("a2", .Range("a" & .Rows.Count)).End(xlUp).Offset(1, 0).Value = sh.Range("d5").Value
End With
End If
Next sh
End Sub
Code: Select all
Sub Button2_Click()
Dim sh As Worksheet
Worksheets("รวมสรุปยอด").Range("a2:a1000").ClearContents
For Each sh In Worksheets
If sh.Name <> "รวมสรุปยอด" Then
With Worksheets("รวมสรุปยอด")
.Range("a3").Offset(Application.CountA(.Range("a3:a" & .Rows.Count)), 0).Value = sh.Range("d5").Value
End With
End If
Next sh
End Sub
Code: Select all
Sub Button2_Click()
Dim sh As Worksheet
Worksheets("รวมสรุปยอด").Range("b4:g31").ClearContents
For Each sh In Worksheets
If sh.Name <> "รวมสรุปยอด" Then
With Worksheets("รวมสรุปยอด")
.Range("b4").Offset(Application.CountA(.Range("b4:b" & .Rows.Count)), 0).Value = sh.Range("a4").Value
.Range("c4").Offset(Application.CountA(.Range("c4:c" & .Rows.Count)), 0).Value = sh.Range("b4").Value
.Range("d4").Offset(Application.CountA(.Range("d4:d" & .Rows.Count)), 0).Value = sh.Range("c4").Value
.Range("e4").Offset(Application.CountA(.Range("e4:e" & .Rows.Count)), 0).Value = sh.Range("d4").Value
.Range("f4").Offset(Application.CountA(.Range("f4:f" & .Rows.Count)), 0).Value = sh.Range("e4").Value
.Range("g4").Offset(Application.CountA(.Range("g4:g" & .Rows.Count)), 0).Value = sh.Range("f4").Value
End With
End If
Next sh
End Sub
Code: Select all
Sub Button2_Click()
Dim sh As Worksheet
Worksheets("รวมสรุปยอด").Range("b4:g31").ClearContents
For Each sh In Worksheets
If sh.Name <> "รวมสรุปยอด" Then
With Worksheets("รวมสรุปยอด")
.Range("b4:g4").Offset(Application.CountA(.Range("b4:b" & .Rows.Count)), 0).Value = sh.Range("a4:f4").Value
End With
End If
Next sh
End Sub
Code: Select all
Sub AllTotal()
StartRow = 2
StartCol = 1
TargetCell = "D5"
SheetsCount = ThisWorkbook.Worksheets.Count
CurrSheet = ActiveSheet.Name
'
' Clear Answer Area
'
WorkRow = StartRow - 1
For i = 1 To SheetsCount - 1
WorkRow = WorkRow + 1
Cells(WorkRow, StartCol).ClearContents
Next i
'
' Put Answer
'
WorkRow = StartRow - 1
For i = 1 To SheetsCount
If Worksheets(i).Name <> CurrSheet Then
WorkRow = WorkRow + 1
Cells(WorkRow, StartCol).Value = Worksheets(i).Range(TargetCell).Value
End If
Next i
End Sub
ขอโทดทีครับ คุณ puriwutpokin ข้อมูลจากชีทที่ต้นทาง อาจจะไม่ได้เรียงแบบนี้ครับpuriwutpokin wrote:ปรับเป็นCode: Select all
Sub Button2_Click() Dim sh As Worksheet Worksheets("รวมสรุปยอด").Range("b4:g31").ClearContents For Each sh In Worksheets If sh.Name <> "รวมสรุปยอด" Then With Worksheets("รวมสรุปยอด") .Range("b4:g4").Offset(Application.CountA(.Range("b4:b" & .Rows.Count)), 0).Value = sh.Range("a4:f4").Value End With End If Next sh End Sub
ข้อมูลต้นทางจะกระจายกันอยู่ ขอยกตัวอย่างอีกรอบนะครับ code ตามไฟล์แนบครับsh.Range("a4:f4").Value
Code: Select all
Sub Button2_Click()
Dim sh As Worksheet
Worksheets("รวมสรุปยอด").Range("b4:g31").ClearContents
For Each sh In Worksheets
If sh.Name <> "รวมสรุปยอด" Then
With Worksheets("รวมสรุปยอด")
.Range("b4").Offset(Application.CountA(.Range("b4:b" & .Rows.Count)), 0).Value = sh.Range("b1").Value
.Range("c4").Offset(Application.CountA(.Range("c4:c" & .Rows.Count)), 0).Value = sh.Range("b10").Value
.Range("d3").Offset(Application.CountA(.Range("d4:d" & .Rows.Count)), 0).Value = sh.Range("b3").Value
.Range("e4").Offset(Application.CountA(.Range("e4:e" & .Rows.Count)), 0).Value = sh.Range("b5").Value
.Range("f3").Offset(Application.CountA(.Range("f4:f" & .Rows.Count)), 0).Value = sh.Range("c7").Value
.Range("g3").Offset(Application.CountA(.Range("g4:g" & .Rows.Count)), 0).Value = sh.Range("d7").Value
End With
End If
Next sh
End Sub