• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Nhờ anh chị sửa dùm em code VBA

Nơi trao đổi về VBA (Visual Basic for Application), lập trình cho ứng dụng Microsoft Office, AutoCAD...

Điều hành viên: tungblt

heyhey1994
Bài viết: 1
Ngày tham gia: T.Sáu 07/06/2013 9:53 pm

Nhờ anh chị sửa dùm em code VBA

Gửi bàigửi bởi heyhey1994 » T.Hai 23/07/2018 11:11 am

Sub Taodayso()

Range("C22:U9999").Select
Selection.Delete Shift:=xlUp

Dim sArr, dArr, sRng As Range, eRng As Range
Dim Dic As Object
Dim i As Long, K As Long, j As Long, Col As Long, N As Long, Nt As Long, Ns As Long, sodong As Long, demdong As Long, t As Long
On Error GoTo Thoat
Set Dic = CreateObject("Scripting.Dictionary")
Set sRng = Sheet1.Range("X22:Y99")
N = 2
sArr = sRng.Value
ReDim dArr(1 To 65535, 1 To UBound(sArr, 2))
For i = 1 To UBound(sArr)
If Not Dic.Exists(sArr(i, N)) Then
Dic.Add sArr(i, N), ""
If sArr(i, N) <> Empty Then
If sArr(i, 1) >= 1 Then
If i = 1 Then Nt = 1
Ns = Int(sArr(i, N))
For j = Nt To Ns
K = K + 1
For Col = 1 To N - 1
dArr(K, Col) = sArr(i, Col)
Next Col
dArr(K, N) = j
Next j
End If
If sArr(i, N) > Int(sArr(i, N)) Then
K = K + 1
For Col = 1 To N - 1
dArr(K, Col) = sArr(i, Col)
Next Col
dArr(K, N) = sArr(i, N)
End If
Nt = Ns + 1
End If
End If
Next i
Set eRng = Sheet1.Range("C22:D22")
eRng.Resize(1500, UBound(sArr, 2)).ClearContents
eRng.Resize(K, UBound(sArr, 2)) = dArr
Set Dic = Nothing
Thoat:
Trong đây là bản VBA em tìm trên mạng chia dãy số cho trước thành 1 đoạn nhỏ nhưng nó chỉ chia cho từng đoạn 1. Ví dụ 5.3 thành 1 1 1 1 1.3. Có cách nào sửa code này để chia thành đoạn 0.5 hoặc 2 ... tùy mình chỉnh được ko ạ.
em cảm ơn.



Quay về “Visual Basic for Application (VBA)”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.4 khách