Vòng lặp để rút ngắn đoạn mã?

[emgaingayngo]

Xin các bạn chỉ cách dùng vòng lặp để rút ngắn đọan mã sau:

Sub ReNew()
Dim th2 As Integer, th3 As Integer, th4 As Integer, th5 As Integer, th6 As Integer, th7 As Integer
Dim th8 As Integer, th9 As Integer, th10 As Integer
th2 = Range("a1").Column
th3 = Range("a43").Column
th4 = Range("a85").Column
th5 = Range("a127").Column
th6 = Range("a169").Column
th7 = Range("a211").Column
th8 = Range("a253").Column
th9 = Range("a295").Column
th10 = Range("a316").Column

If th2 = 256 Then
Range("a1:dx41").ClearContents
Range("dy1:iv41").Select: Selection.Copy
Range("a1").PasteSpecial (xlPasteValues)
Range("dy1:iv41").ClearContents

ElseIf th3 = 256 Then
Range("a43:dx83").ClearContents
Range("dy43:iv83").Select: Selection.Copy
Range("a43").PasteSpecial (xlPasteValues)
Range("dy43:iv83").ClearContents

ElseIf th4 = 256 Then
Range("a85:dx125").ClearContents
Range("dy85:iv125").Select: Selection.Copy
Range("a85").PasteSpecial (xlPasteValues)
Range("dy85:iv125").ClearContents

ElseIf th5 = 256 Then
Range("a127:dx167").ClearContents
Range("dy127:iv167").Select: Selection.Copy
Range("a127").PasteSpecial (xlPasteValues)
Range("dy127:iv167").ClearContents

ElseIf th6 = 256 Then
Range("a169:dx209").ClearContents
Range("dy169:iv209").Select: Selection.Copy
Range("a169").PasteSpecial (xlPasteValues)
Range("dy169:iv209").ClearContents

ElseIf th7 = 256 Then
Range("a211:dx251").ClearContents
Range("dy211:iv251").Select: Selection.Copy
Range("a211").PasteSpecial (xlPasteValues)
Range("dy211:iv251").ClearContents

ElseIf th8 = 256 Then
Range("a253:dx293").ClearContents
Range("dy253:iv293").Select: Selection.Copy
Range("a253").PasteSpecial (xlPasteValues)
Range("dy253:iv293").ClearContents

ElseIf th9 = 256 Then
Range("a295:dx314").ClearContents
Range("dy295:iv314").Select: Selection.Copy
Range("a295").PasteSpecial (xlPasteValues)
Range("dy295:iv314").ClearContents

ElseIf th10 = 256 Then
Range("a316:dx356").ClearContents
Range("dy316:iv356").Select: Selection.Copy
Range("a316").PasteSpecial (xlPasteValues)
Range("dy316:iv356").ClearContents
End If
End Sub

Thanks Much!

 

[digita]

Chào bạn,

Trước hết bạn nên coi lại cái những dòng nầy nhá. thí dụ th2 = Range("a1").Column v.v. Các câu mạ như thế chỉ cho trị giá lá 1 thôi. Theo mình đoán là bạn muốn kiểm tra coi vùng dử liệu đã chiếm đầy 256 cột chưa. Nếu vậy thì nên thay đổi mã thành là thí dụ:

If Range("a1").CurrentRegion.Columns.Count = 256 then
.......

Cái code bạn có thể rút ngắn bằng cách loại bõ thao tác copy-paste value thay vào đó là mệnh lệnh tương đương với Cut-paste.

Code được sửa lại như sau:

---------------------------------
Sub ReNew()
If Range("a1").CurrentRegion.Columns.Count = 256 Then
Range("A1X41").Cut Range("dy1:iv41")
ElseIf Range("a43").CurrentRegion.Columns.Count = 256 Then
Range("a43:dx83").Cut Range("dy43:iv83")
ElseIf Range("a85").CurrentRegion.Columns.Count = 256 Then
Range("a85:dx125").Cut Range("dy85:iv125")
ElseIf Range("a127").CurrentRegion.Columns.Count = 256 Then
Range("a127:dx167").Cut Range("dy127:iv167")
ElseIf Range("a169").CurrentRegion.Columns.Count = 256 Then
Range("a169:dx209").Cut Range("dy169:iv209")
ElseIf Range("a211").CurrentRegion.Columns.Count = 256 Then
Range("a211:dx251").Cut Range("dy211:iv251")
ElseIf Range("a253").CurrentRegion.Columns.Count = 256 Then
Range("a253:dx293").Cut Range("dy253:iv293")
ElseIf Range("a295").CurrentRegion.Columns.Count = 256 Then
Range("a295:dx314").Cut Range("dy295:iv314")
ElseIf Range("a316").CurrentRegion.Columns.Count = 256 Then
Range("a316:dx356").Cut Range("dy316:iv356")
End If
End Sub
------------------------------------------

Mến chào.

 

[emgaingayngo]

Đúng rồi, mình bị sai rồi

th2 = Range("a1").Column
th3 = Range("a43").Column
th4 = Range("a85").Column
th5 = Range("a127").Column
th6 = Range("a169").Column
th7 = Range("a211").Column
th8 = Range("a253").Column
th9 = Range("a295").Column
th10 = Range("a316").Column

Mình sửa lại nha:

th2 = Range("ThuHai").Column
th3 = Range("ThuBa").Column
th4 = Range("ThuTu").Column
th5 = Range("ThuNam").Column
th6 = Range("ThuSau").Column
th7 = Range("ThuBay").Column
th8 = Range("ThuTam").Column
th9 = Range("ThuChin").Column
th10 = Range("Th10").Column

Cảm ơn bạn về đọan mã.

 

[phamduylong]

Bạn nên trình bày yêu cầu của bạn và cách viết của bạn để góp ý. Thật sự không hiểu bạn muốn làm gì !

 

[Mr Okebab]

Chào bạn,

Trước hết bạn nên coi lại cái những dòng nầy nhá. thí dụ th2 = Range("a1").Column v.v. Các câu mạ như thế chỉ cho trị giá lá 1 thôi. Theo mình đoán là bạn muốn kiểm tra coi vùng dử liệu đã chiếm đầy 256 cột chưa. Nếu vậy thì nên thay đổi mã thành là thí dụ:

If Range("a1").CurrentRegion.Columns.Count = 256 then
.......

Cái code bạn có thể rút ngắn bằng cách loại bõ thao tác copy-paste value thay vào đó là mệnh lệnh tương đương với Cut-paste.

Code được sửa lại như sau:

---------------------------------
Sub ReNew()
If Range("a1").CurrentRegion.Columns.Count = 256 Then
Range("A1X41").Cut Range("dy1:iv41")
ElseIf Range("a43").CurrentRegion.Columns.Count = 256 Then
Range("a43:dx83").Cut Range("dy43:iv83")
ElseIf Range("a85").CurrentRegion.Columns.Count = 256 Then
Range("a85:dx125").Cut Range("dy85:iv125")
ElseIf Range("a127").CurrentRegion.Columns.Count = 256 Then
Range("a127:dx167").Cut Range("dy127:iv167")
ElseIf Range("a169").CurrentRegion.Columns.Count = 256 Then
Range("a169:dx209").Cut Range("dy169:iv209")
ElseIf Range("a211").CurrentRegion.Columns.Count = 256 Then
Range("a211:dx251").Cut Range("dy211:iv251")
ElseIf Range("a253").CurrentRegion.Columns.Count = 256 Then
Range("a253:dx293").Cut Range("dy253:iv293")
ElseIf Range("a295").CurrentRegion.Columns.Count = 256 Then
Range("a295:dx314").Cut Range("dy295:iv314")
ElseIf Range("a316").CurrentRegion.Columns.Count = 256 Then
Range("a316:dx356").Cut Range("dy316:iv356")
End If
End Sub
------------------------------------------

Mến chào.

Còn có thể rút gọn nữa bạn ạ. Bạn để ý thấy tất cả sẽ thao tác từ cột A đến cột DX, gồm 40 hàng

Vậy thì hãy rút gọn thêm lại vì chúng có qui luật mà.

Thân !

 

[emgaingayngo]

Đúng rồi đó Mr Okebab! bạn chỉ mình cụ thể nha

 

[Mr Okebab]

Đúng rồi đó Mr Okebab! bạn chỉ mình cụ thể nha

Bạn xem nhé

Sub ReNew()
Dim th2 As Integer, th3 As Integer, th4 As Integer, th5 As Integer, th6 As Integer, th7 As Integer
Dim th8 As Integer, th9 As Integer, th10 As Integer
th2 = Range("ThuHai").Column
th3 = Range("ThuBa").Column
th4 = Range("ThuTu").Column
th5 = Range("ThuNam").Column
th6 = Range("ThuSau").Column
th7 = Range("ThuBay").Column
th8 = Range("ThuTam").Column
th9 = Range("ThuChin").Column
th10 = Range("Th10").Column

Dim i As Integer
i = 0
If th2 = 256 Then i = 1
ElseIf th3 = 256 Then i = 43
ElseIf th4 = 256 Then i = 85
ElseIf th5 = 256 Then i = 127
ElseIf th6 = 256 Then i = 169
ElseIf th7 = 256 Then i = 211
ElseIf th8 = 256 Then i = 253
ElseIf th9 = 256 Then i = 295
ElseIf th10 = 256 Then i = 316

End If

if i >0 then

Range("A" & i & "X" & i + 40).Value = Range("DY" & i & ":IV" & i + 40).Value
Range("DY" & i & ":IV" & i + 40).ClearContents

end if

End Sub


Mình không biết File của bạn thế nào nhưng hình như cách khai báo và đặt name của bạn chưa hợp lý lắm
Thân!

 

[SA_DQ]

(òn có thể rút được nữa!

[b]Sub ReNew()[/b]
[COLOR="Blue"]'Dim th2 As Integer, th3 As Integer, th4 As Integer, th5 As Integer, th6 As Integer, th7 As Integer
'Dim th8 As Integer, th9 As Integer, th10 As Integer [/COLOR]
' Các biến này nên là: Redim MangTH(12) As Integer để xài trong vòng lặp
' Lúc đó
'th2 = Range("ThuHai").Column:   th3 = Range("ThuBa").Column
'th4 = Range("ThuTu").Column:     th5 = Range("ThuNam").Column
'th6 = Range("ThuSau").Column . . .  được thay =:
 MangTh(ij) = Range("...")
 ' Sau dòng  Dim i As Integer ta dùng vòng lặp For . . . Next
 For ij = 1 to 335 Step 42
      If MangTh(ij) = 256 then  i= ij:     Exit For
 Next ij
[COLOR="Yellow"]i = 0
If th2 = 256 Then i = 1
ElseIf th3 = 256 Then i = 43:        ElseIf th4 = 256 Then i = 85
ElseIf th5 = 256 Then i = 127:      ElseIf th6 = 256 Then i = 169
ElseIf th7 = 256 Then i = 211:      ElseIf th8 = 256 Then i = 253
ElseIf th9 = 256 Then i = 295:      ElseIf th10 = 256 Then i = 316
End If[/COLOR]
If i >0 then

Range("A" & i & ":DX" & i + 40).Value = Range("DY" & i & ":IV" & i + 40).Value
Range("DY" & i & ":IV" & i + 40).ClearContents
End If
End Sub[/B][/COLOR]

Mình không biết File của bạn thế nào nhưng hình như còn có thể rút gọn được nữa!

 

[vungoc]

Các bác đúng là tài thật, mà lại zui zẻ nữa !

 

[phamduylong]

Với bài toán này, do thao tác "cut" lặp lại và vùng chọn để thực hiện lệnh cut có quy luật nên sử dụng vòng lặp do - loop hoặc for - next là gọn nhất.
Do số lần lặp đã xác định nên tôi chọn for - next.
Tuy nhiên, số thứ tự dòng sau mỗi vòng lặp giống nhau ở lần 1 > 6, đến lần 7, 8, 9 lại thay đổi (không biết emgaingayngo có định đánh đố anh em không?) nên sau mỗi vòng lặp phải kiểm tra lại bước nhảy của số thứ tự dòng.
Bài toán này được viết lại như sau:

Sub ReNew()
rd = 1: rc = 41
For n = 1 To 9
If Cells(rd, 1).CurrentRegion.Columns.Count = 256 Then
Range(Cells(rd, 129), Cells(rc, 256)).Cut Range(Cells(rd, 1), Cells(rc, 128))
End If
If rd < 253 Then
rd = rd + 42: rc = rc + 42
ElseIf rd = 253 Then
rd = rd + 42: rc = rc + 21
ElseIf rd = 295 Then
rd = rd + 21: rc = rc + 42
End If
Next
End Sub

Qua bài toán này, tôi có ý kiến sau:
Các bạn sử dụng đối tượng Range để xác định địa chỉ ô. Theo tôi, có thể xác định địa chỉ ô bằng 1 trong 2 đối tượng là Cells hoặc Range.
Cells(dòng, cột): để xác định địa chỉ 1 ô. Ví dụ ô IV2 thì viết Cells(2,256) chú ý là dòng trước, cột sau.
Range(Cells(dòng đầu, cột đầu), Cells(dòng cuối, cột cuối)) để xác định 1 vùng nhiều ô từ ô đầu đến ô cuối. Ví dụ vùng A29 có 2 cách ghi:
- Range("A2:B9") hoặc:
- Range(Cells(2,1),Cells(9,2)).
Dùng đối tượng Cells ghi dài hơn, nhưng khi viết chương trình linh hoạt hơn vì ta có thể thay dòng, cột bằng biến số.
Ví dụ để ghi vào A1:A100 các số 1,3,5, ... ta viết:
n=1
For r=1 to 100
Cells(r,1)=n
n=n+2
Next