- Tham gia
- 29/4/08
- Bài viết
- 95
- Được thích
- -2
Cái danh sách của mình khá dài mà 1 sheet chỉ có 65536. Do vậy mình muốn cho nó bắt đầu chạy từ số bất kỳ theo ý mình chứ không phải từ số "00001" vd "65537"
Lần chỉnh sửa cuối:
giúp mình cho macro sẽ chạy tiếp khi chuyển sang 1 sheet mới (1 người xem)
- Thread starter tuan206791
- Ngày gửi
Người dùng đang xem chủ đề này
- Tham gia
- 25/9/09
- Bài viết
- 5,729
- Được thích
- 8,858
- Giới tính
- Nam
- Nghề nghiệp
- Giáo viên
Bạn làm như sau:
1. Thêm 1 biến bd kiểu long vào phần khai báo (số bắt đầu)
2. Thêm câu lệnh: bd = InputBox("Nhap so bat dau: ") vào trước vòng For
3. Sửa câu lệnh: Kq(i * 8 - 5) = Space(3) & "<ID>" & Right("0000" & i, 5) & "</ID>"
thành câu lệnh: Kq(i * 8 - 5) = Space(3) & "<ID>" & Right("0000" & i + bd - 1, 5) & "</ID>"
Bạn cũng có thể thay số 5 ở trên bởi số khác cho phù hợp với thực tế.
Upvote
0
- Tham gia
- 8/6/06
- Bài viết
- 14,689
- Được thích
- 23,042
- Nghề nghiệp
- U80
Thiết nghĩ, đây sẽ là sửa ít nhứt
PHP:
Option Explicit
Sub TaoDS()
1 Dim Kq(), i, j, tam, Rng As Range, BD As Long
Set Rng = Sheet1.Range(Sheet1.[A2], Sheet1.[A2].End(4))
2 BD = InputBox("Hay Nhap Dòng Bát Dàu", "GPE.COM Xin Chào Ban!", 99)
If BD > Rng.Count Then Exit Sub
3 For i = BD To Rng.Count
ReDim Preserve Kq(1 To i * 8)
Kq(i * 8 - 7) = Space(2) & "</SOFTWARESMOBILE_MANAGER>"
Kq(i * 8 - 6) = Space(2) & "<SOFTWARESMOBILE_MANAGER>"
Kq(i * 8 - 5) = Space(3) & "<ID>" & Right("0000" & i, 5) & "</ID>"
Kq(i * 8 - 4) = Space(3) & "<Filename>" & _
Right(Rng(i).Value, InStr(1, StrReverse(Rng(i).Value), "\") - 1) & "</Filename>"
Kq(i * 8 - 3) = Space(3) & "<Path>" & _
Left(Rng(i).Value, Len(Rng(i)) - Len(Kq(i * 8 - 4)) + 23) & "</Path>"
Kq(i * 8 - 2) = Space(3) & "<Theloai />"
Kq(i * 8 - 1) = Space(3) & "<Loaimay />"
Kq(i * 8) = Space(3) & "<Khac />" '"
Next
Sheet2.Columns("A").Clear
Sheet2.[A1].Resize(UBound(Kq)) = WorksheetFunction.Transpose(Kq)
Set Rng = Sheet2.[A1].Resize(UBound(Kq))
For i = 1 To UBound(Kq) / 8
With Rng(i * 8 - 7).Resize(2).Interior
.ColorIndex = 36: .Pattern = xlSolid
End With
With Rng(i * 8 - 2).Resize(3).Interior
.ColorIndex = 36: .Pattern = xlSolid
End With
Rng(i * 8 - 5).Resize(3).Font.ColorIndex = 44
Rng(i * 8 - 5).Characters(8, 5).Font.ColorIndex = 10
Rng(i * 8 - 4).Characters(14, Len(Rng(i * 8 - 4)) - 24).Font.ColorIndex = 5
Rng(i * 8 - 3).Characters(10, Len(Rng(i * 8 - 3)) - 16).Font.ColorIndex = 7
Next
4 Sheet2.Range([A2], [A1].End(xlDown).Offset(-1)).EntireRow.Delete
End Sub
Upvote
0
- Tham gia
- 29/4/08
- Bài viết
- 95
- Được thích
- -2
Em không phải chuyên ngành này nên không biết cách, nhờ anh làm giúp em
Upvote
0
- Tham gia
- 29/4/08
- Bài viết
- 95
- Được thích
- -2
Mình thử chạy không được. Mình muốn khi nhấp vào "Tạo Báo cáo" sẽ hiển thị một box cho mình nhập số bắt đầu
Upvote
0
- Tham gia
- 29/4/08
- Bài viết
- 95
- Được thích
- -2
Cái thực ra cũng không muốn phiền mọi người trong rum. Nhưng không biết thì phải học hỏi mọi người chứ cứ bỏ tiền ra thì rồi chẳng biết gì
Upvote
0
- Tham gia
- 8/6/06
- Bài viết
- 14,689
- Được thích
- 23,042
- Nghề nghiệp
- U80
Bạn chạy như thế nào mà không được?
Dòng lệnh có số 1 có khai thêm biến số kiểu Long để dùng;
Dòng lệnh có số 2: Hiện hộp thoại cho fép bạn nhập số bắt đầu chép; Mặc định đang là 99
Dòng lệnh có số 3: Sửa lại macro cũ, chỉ cho chép từ số (dòng) bắt đầu mà ta đã nhập cho biến;
Dòng lệnh có số 4: Xóa ~ dòng trống fía trên các hàng có dữ liệu;
Bạn lấy cái con macro này chép đè lên con macro cũ & bấm nút dưới xem sao!
Dòng lệnh có số 1 có khai thêm biến số kiểu Long để dùng;
Dòng lệnh có số 2: Hiện hộp thoại cho fép bạn nhập số bắt đầu chép; Mặc định đang là 99
Dòng lệnh có số 3: Sửa lại macro cũ, chỉ cho chép từ số (dòng) bắt đầu mà ta đã nhập cho biến;
Dòng lệnh có số 4: Xóa ~ dòng trống fía trên các hàng có dữ liệu;
Bạn lấy cái con macro này chép đè lên con macro cũ & bấm nút dưới xem sao!
Upvote
0
- Tham gia
- 29/4/08
- Bài viết
- 95
- Được thích
- -2
Mình đã thử xóa cái macro cũ đi và chép dòng lệnh của bạn nhưng bị báo lỗi. Bạn kiểm tra giúp
Upvote
0
sealand
Thành viên gạo cội
- Tham gia
- 16/5/08
- Bài viết
- 4,883
- Được thích
- 7,688
- Giới tính
- Nam
- Nghề nghiệp
- Kế Toán
Bạn sửa code 1 chút như sau
Mã:
Sub TaoDS()
Dim Kq(), i, j, tam, Rng As Range
On Error Resume Next
Set Rng = Application.InputBox("Quet chon hoac nhap vung du lieu.", "GPE", , , , , , 8)
If Rng Is Nothing Then
MsgBox "Ban chua nhap du lieu!": Exit Sub
ElseIf Rng.Columns.Count > 1 Then
MsgBox "Ban nhap du lieu 1 cot thoi!": Exit Sub
ElseIf Rng.Count > 8192 Then
MsgBox "Moi lan chay Macro ban chi chon toi da 8.192 o thoi!": Exit Sub
End If
For i = 1 To Rng.Count
ReDim Preserve Kq(1 To i * 8)
Kq(i * 8 - 7) = Space(2) & "</SOFTWARESMOBILE_MANAGER>"
Kq(i * 8 - 6) = Space(2) & "<SOFTWARESMOBILE_MANAGER>"
Kq(i * 8 - 5) = Space(3) & "<ID>" & Right("0000" & i, 5) & "</ID>"
Kq(i * 8 - 4) = Space(3) & "<Filename>" & Right(Rng(i).Value, InStr(1, StrReverse(Rng(i).Value), "\") - 1) & "</Filename>"
Kq(i * 8 - 3) = Space(3) & "<Path>" & Left(Rng(i).Value, Len(Rng(i)) - Len(Kq(i * 8 - 4)) + 23) & "</Path>"
Kq(i * 8 - 2) = Space(3) & "<Theloai />"
Kq(i * 8 - 1) = Space(3) & "<Loaimay />"
Kq(i * 8) = Space(3) & "<Khac />"
Next
Sheet2.Columns("A").Clear
Sheet2.[A1].Resize(UBound(Kq)) = WorksheetFunction.Transpose(Kq)
Set Rng = Sheet2.[A1].Resize(UBound(Kq))
For i = 1 To UBound(Kq) / 8
With Rng(i * 8 - 7).Resize(2).Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Rng(i * 8 - 2).Resize(3).Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
Rng(i * 8 - 5).Resize(3).Font.ColorIndex = 44
Rng(i * 8 - 5).Characters(8, 5).Font.ColorIndex = 10
Rng(i * 8 - 4).Characters(14, Len(Rng(i * 8 - 4)) - 24).Font.ColorIndex = 5
Rng(i * 8 - 3).Characters(10, Len(Rng(i * 8 - 3)) - 16).Font.ColorIndex = 7
Next
End Sub
Upvote
0
- Tham gia
- 29/4/08
- Bài viết
- 95
- Được thích
- -2
Không được anh ạ. báo lỗi rồi bác xem lại giúp em nhé ý em muốn nói là khi dữ liệu chạy tới ô cuối cùng của sheet là 65536, mà dữ liệu chưa hết. lúc này em phải làm sang 1 sheet mới mà nhưng nó lại bắt lại từ đầu là "00001". Em muốn nó tiếp theo là 65537 anh ạ
Lần chỉnh sửa cuối:
Upvote
0
huuthang_bd
Chuyên gia GPE
- Tham gia
- 10/9/08
- Bài viết
- 8,933
- Được thích
- 11,353
- Donate (Momo)
- Giới tính
- Nam
- Nghề nghiệp
- Thợ đụng
Bạn tải file này về chạy thử xem nhé.
Upvote
0
- Tham gia
- 29/4/08
- Bài viết
- 95
- Được thích
- -2
Mình có tải lại file bạn xem lại giúp. Hình như mọi người không hiểu ý mình nói
Upvote
0
huuthang_bd
Chuyên gia GPE
- Tham gia
- 10/9/08
- Bài viết
- 8,933
- Được thích
- 11,353
- Donate (Momo)
- Giới tính
- Nam
- Nghề nghiệp
- Thợ đụng
Vậy thì sửa lại một chút. Xem trong file nhé.
File của tôi, bạn cứ làm 1 phát, bao nhiêu cũng đủ.
Lần chỉnh sửa cuối:
Upvote
0
- Tham gia
- 29/4/08
- Bài viết
- 95
- Được thích
- -2
Mình chạy thử với số 5000 thì không thấy có kết quả gì bạn ạ. Còn với những số nhỏ thì được dưới 10 thì được
Upvote
0
huuthang_bd
Chuyên gia GPE
- Tham gia
- 10/9/08
- Bài viết
- 8,933
- Được thích
- 11,353
- Donate (Momo)
- Giới tính
- Nam
- Nghề nghiệp
- Thợ đụng
File bạn có bao nhiêu dòng mà chạy 5000 dòng???
Tôi sửa lại chỗ này luôn. Nếu số dòng khai báo vượt quá dữ liệu thì chạy đến dòng dữ liệu cuối cùng.
File này bạn sử dụng như sau:
Click vào nút Tạo báo cáo
Hiện ra một Inputbox, bạn nhập dòng bắt đầu vào, click OK
Hiện tiếp một Inputbox, bạn nhập số dòng cần chuyển vào, click OK
Lưu ý: Nếu muốn chuyển hết thì ở cái Inputbox thứ hai nhập số 0 vào.
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,970
Không biết tôi hiểu có đúng ý bạn chưa nữa ---> Xem file nhé (tôi sửa 1 tí vào file của bạn thôi)
Upvote
0
- Tham gia
- 29/4/08
- Bài viết
- 95
- Được thích
- -2
chính xác anh ạ. VIP từ sáng không ai hiểu hết có mỗi bác hiểu em
Upvote
0
sealand
Thành viên gạo cội
- Tham gia
- 16/5/08
- Bài viết
- 4,883
- Được thích
- 7,688
- Giới tính
- Nam
- Nghề nghiệp
- Kế Toán
Mình sửa lại code cho bạn, mình đã test với khoảng 10.000 dòng data cho kết quả tốt. Nhưng do định dang theo ký tự từng ô nên code khá chậm. Bạn vui lòng tham khảo nha. Chả cần biết bạn làm bao nhiêu. Nếu quá dòng thì thêm sheet làm 1 nhát là xong khỏi chọn.
*Lưu ý: Đừng sốt ruột, vì anh em đều còn công việc nữa.
Mã:
Sub TaoDS()
Dim Kq(), Kq1(), i, j, k, Rng As Range, sh As Worksheet
MsgBox "Do dinh dang theo o nen thoi gian cham.Xin cho" & Chr(10) & "(Nhan OK code moi bat dau chay)"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Rng = Sheet1.Range(Sheet1.[A2], Sheet1.[A2].End(4))
For i = 1 To Rng.Count
ReDim Preserve Kq(1 To i * 8)
Kq(i * 8 - 7) = Space(2) & "</SOFTWARESMOBILE_MANAGER>"
Kq(i * 8 - 6) = Space(2) & "<SOFTWARESMOBILE_MANAGER>"
Kq(i * 8 - 5) = Space(3) & "<ID>" & Right("0000" & i, 5) & "</ID>"
Kq(i * 8 - 4) = Space(3) & "<Filename>" & Right(Rng(i).Value, InStr(1, StrReverse(Rng(i).Value), "\") - 1) & "</Filename>"
Kq(i * 8 - 3) = Space(3) & "<Path>" & Left(Rng(i).Value, Len(Rng(i)) - Len(Kq(i * 8 - 4)) + 23) & "</Path>"
Kq(i * 8 - 2) = Space(3) & "<Theloai />"
Kq(i * 8 - 1) = Space(3) & "<Loaimay />"
Kq(i * 8) = Space(3) & "<Khac />"
Next
For Each sh In Sheets
If InStr(1, sh.Name, "Kqua") > 0 Then sh.Delete
Next
Do
ReDim Kq1(1 To 65536)
For j = 1 To IIf(UBound(Kq) - k * 65536 > 65536, 65536, UBound(Kq) - k * 65536)
Kq1(j) = Kq(k * 65536 + j)
Next
Set sh = Worksheets.Add
sh.Name = "Kqua-" & k + 1
sh.[a1].Resize(UBound(Kq1)) = WorksheetFunction.Transpose(Kq1)
sh.Columns("A").AutoFit
MauSh sh
k = k + 1
If k * 65536 >= UBound(Kq) Then Exit Do
Loop
End Sub
'-----------Day la code to mau
Sub MauSh(ByVal sh As Object)
Dim Rng As Range, i
Set Rng = sh.[a1].Resize(WorksheetFunction.CountA(sh.[a1:a65536]))
For i = 1 To Rng.Count / 8
With Rng(i * 8 - 7).Resize(2).Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Rng(i * 8 - 2).Resize(3).Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
Rng(i * 8 - 5).Resize(3).Font.ColorIndex = 44
Rng(i * 8 - 5).Characters(8, 5).Font.ColorIndex = 10
Rng(i * 8 - 4).Characters(14, Len(Rng(i * 8 - 4)) - 24).Font.ColorIndex = 5
Rng(i * 8 - 3).Characters(10, Len(Rng(i * 8 - 3)) - 16).Font.ColorIndex = 7
Next
End Sub*Lưu ý: Đừng sốt ruột, vì anh em đều còn công việc nữa.
Lần chỉnh sửa cuối:
Upvote
0
Bài viết mới nhất
- Question
- Question
- Question
- Question
- Question
