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
Public Sub EnvelopePaste()
Dim rSource As Range
Dim rTarget As Range
Dim i As Long, j As Long
Dim stCol As Byte
Application.ScreenUpdating = False
With Sheets("·ÓÃٻẺ¾ÔÁ¾ì㺻Ð˹éÒ")
.Range("A:O").UnMerge
'.Range("A:O").ClearContents
If .Range("a1").Value = "" Then
stCol = 1
j = 1
ElseIf .Range("b" & .Rows.Count).End(xlUp) = "" Then
stCol = 1
j = .Range("b" & .Rows.Count).End(xlUp).Row - 4
Else
stCol = 7
j = .Range("i" & .Rows.Count).End(xlUp).Row - 4
End If
End With
Set rSource = Sheets("Sheet1").Range("A1:G5")
'j = 1
For i = 1 To 10000 Step 2
Sheets("Sheet1").Range("H1") = i
If Sheets("KTB").Range("B" & i + 1) = "" Then Exit For
With Sheets("·ÓÃٻẺ¾ÔÁ¾ì㺻Ð˹éÒ")
Set rTarget = .Range(.Range("A" & j), .Range("G" & j + 4))
' End With
If stCol = 1 Then
rSource.Copy
rTarget.PasteSpecial xlPasteValues
rTarget.PasteSpecial xlPasteFormats
Sheets("Sheet1").Range("H1") = i + 1
rSource.Copy
rTarget.Offset(0, 7).PasteSpecial xlPasteValues
rTarget.Offset(0, 7).PasteSpecial xlPasteFormats
j = j + 5
Else
rSource.Copy
rTarget.Offset(0, 7).PasteSpecial xlPasteValues
rTarget.Offset(0, 7).PasteSpecial xlPasteFormats
j = j + 5
Set rTarget = .Range(.Range("A" & j), .Range("G" & j + 4))
Sheets("Sheet1").Range("H1") = i + 1
rSource.Copy
rTarget.PasteSpecial xlPasteValues
rTarget.PasteSpecial xlPasteFormats
End If
End With
Next i
Application.CutCopyMode = False
MsgBox "Finish"
Application.ScreenUpdating = True
End Sub