hoanglocphat
Thành viên thường trực
- Tham gia
- 27/1/13
- Bài viết
- 258
- Được thích
- 30
Các bạn giúp giùm bài toán như trong file đính kèm
Cảm ơn các bạn!
Cảm ơn các bạn!
Giúp đánh số thứ tự cho những mã trùng nhau và tính số lượng từng mã trùng (1 người xem)
- Thread starter hoanglocphat
- Ngày gửi
Người dùng đang xem chủ đề này
Mình nhìn nhầm, bài #12 có tới 2 vòng lập, bài mình chỉ có 1 vòng lập tương tự bài #13, vòng lập Function chỉ thay thếBài #12 mà anh
Application.WorksheetFunction.CountIf() thôi, thực ra lệnh Application.WorksheetFunction.CountIf() khi thực hiện phải duyệt qua tất cả các dòng, nên cũng là 1 vòng lập, số dòng nhiều sẽ chạy chậm
Upvote
0
Mang tiếng là 1 vòng lặp nhưng nếu lồng ba cái hàm dò ấy vào vòng lặp thì nó trở thành vòng lặp trong vòng lặp.
Thà dùng nhiều vòng lặp nhưng rời nhau sẽ hiệu quả hơn - và code như thế thường dễ chỉnh sửa hơn.
Thà dùng nhiều vòng lặp nhưng rời nhau sẽ hiệu quả hơn - và code như thế thường dễ chỉnh sửa hơn.
Upvote
0
Các bài trên là làm theo yêu cầu:
Bạn phân tích quá chính xác , các vòng lặp lồng nhau sẽ làm khối lượng xử lý rất lớn
Mình viết lại theo gợi ý của bạn
Mã:
Sub GPE()
Dim Arr(), Darr(), i As Long, K As Long, Num As Long, Key As String
Darr = Range("R19", Range("R60000").End(xlUp)).Value
ReDim Arr(1 To UBound(Darr), 1 To 1)
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Darr)
If Darr(i, 1) <> Empty Then
Key = "#" & Darr(i, 1) & "#"
.Item(Key) = .Item(Key) + 1
End If
Next i
For i = 1 To UBound(Darr)
Num = .Item("#" & Darr(i, 1) & "#")
If Num > 1 Then
Key = Darr(i, 1)
If Not .Exists(Key) Then
K = K + 1
.Item(Key) = "'" & K & "/" & Num
End If
Arr(i, 1) = .Item(Key)
End If
Next i
End With
Range("S19").Resize(i - 1) = Arr
End Sub
Upvote
0
Đã lỡ lôi đít ra rồi thì chơi luôn 2 cái đít. Trước sau gì cũng đã mang tiếng xài đồ xịn.
Trong code sau đây. Cái dic thứ nhất dùng để đếm số lần lặp lại. Cái dic thứ hai dùng để cho số thứ tự.
Trong code sau đây. Cái dic thứ nhất dùng để đếm số lần lặp lại. Cái dic thứ hai dùng để cho số thứ tự.
Mã:
Sub t()
Dim aIn As Variant, aOut()
Dim dic1 As Object, dic2 As Object
Dim key As String
Dim num As Integer, ord As Integer, i As Integer
aIn = Range("R19", Range("R60000").End(xlUp)).Value
ReDim aOut(1 To UBound(aIn), 1 To 1)
Set dic1 = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
' dic1 ghi số lần lặp lại của mã
' khi số lần lặp lại là 2 thì ghi mã qua dic2
For i = 1 To UBound(aIn)
key = CStr(aIn(i, 1))
num = CInt(dic1(key))
If num = 1 Then
' gap lai key lan dau tien (cac lan sau num > 1)
ord = ord + 1
dic2(key) = ord
End If
dic1(key) = num + 1
Next i
For i = 1 To UBound(aIn)
key = CStr(aIn(i, 1))
If dic2.exists(key) Then aOut(i, 1) = dic2(key) & "/" & dic1(key)
Next i
Range("T19").Resize(UBound(aIn)) = aOut
End Sub
Upvote
0
concogia
Gội rồi mới Cạo
- Tham gia
- 17/9/09
- Bài viết
- 3,412
- Được thích
- 6,877
Nếu tui bị bắt phải viết bài này, tui sẽ chơi 1 em "đít-to" và "vòng hai", nhầm, 2 vòng lặp
Vòng 1: nạp dữ liệu vào "Đít"
Vòng 2: vừa đánh số thứ tự kết hợp xuất kết qủa
Nếu dữ liệu in ít thì có thể sử dụng một thằng TRANSPOSE, 1 em "đít-to" và 1 vòng có thể "xử" thằng này
Mới ngủ dậy, viết đại, hông biết có kẹt chỗ nào hông nữa. Híc
Thân
Vòng 1: nạp dữ liệu vào "Đít"
Vòng 2: vừa đánh số thứ tự kết hợp xuất kết qủa
PHP:
Public Sub ToTiTe()
Dim Vung, Dic, I, Tam() As String, K
Vung = Range([R19], [R50000].End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
ReDim Tam(1 To UBound(Vung), 1 To 1)
For I = 1 To UBound(Vung)
If Vung(I, 1) <> Empty Then
If Not Dic.exists(Vung(I, 1)) Then
Dic.Add (Vung(I, 1)), 1
Else
Dic.Item(Vung(I, 1)) = Dic.Item(Vung(I, 1)) + 1
End If
End If
Next I
For I = 1 To UBound(Vung)
If Vung(I, 1) <> Empty Then
If IsNumeric(Dic.Item(Vung(I, 1))) And Dic.Item(Vung(I, 1)) > 1 Then
K = K + 1
Dic.Item(Vung(I, 1)) = K & "/ " & Dic.Item(Vung(I, 1))
Tam(I, 1) = Dic.Item(Vung(I, 1))
ElseIf IsNumeric(Dic.Item(Vung(I, 1))) = False Then
Tam(I, 1) = Dic.Item(Vung(I, 1))
End If
End If
Next I
[T19].Resize(I - 1) = Tam
End SubMới ngủ dậy, viết đại, hông biết có kẹt chỗ nào hông nữa. Híc
Thân
Upvote
0
Góp vui thêm một code dùng 1 Dic và 2 Key
Mã:
Sub GPE()
Dim Arr(), Darr(), i As Long, K As Long, Num As Long, Key As String
Darr = Range("R19", Range("R60000").End(xlUp)).Value
ReDim Arr(1 To UBound(Darr), 1 To 1)
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Darr)
If Darr(i, 1) <> Empty Then
Key = "#" & Darr(i, 1) & "#" 'Key dung de dem
.Item(Key) = .Item(Key) + 1 'Dem so lan lap lai cua Ma va gan vao Dic
If .Item(Key) = 2 Then 'Xet dieu ghi nhan ma vao Dic ket qua
K = K + 1 'So thu tu cua Ma
.Item(Darr(i, 1)) = K 'Gan Ma va so thu tu vao Dic ket qua
End If
End If
Next i
For i = 1 To UBound(Darr)
Key = Darr(i, 1) 'Key dung de lay ket qua va so thu tu
If .Exists(Key) Then Arr(i, 1) = "'" & .Item(Key) & "/" & .Item("#" & Darr(i, 1) & "#")
Next i
End With
Range("S19").Resize(i - 1) = Arr
End Sub
Upvote
0
Bài #25:
Thuật toán bài này giảm thiểu được số lần ghi keys trong dic. Nhưng cũng phải ghi lại item (phần có "/". Phần đếm số lần lặp lại thì thuật toán nào cũng phải làm). So sánh với thuật toán dùng 2 dics thì có thể lợi hơn nếu số mã có lặp lại nhiều gần bằng số mã. Nếu số mã lặp lại rất ít so với số mã thì dùng 2 dics gọn hơn.
Bài #26:
Thuật toán này khong khác dùng 2 dics. Tuy nó giảm được cái dic thứ hai nhưng cũng làm cho cái mục lục của dic lớn hơn (xem lưu ý bên dưới).
Lưu ý là thuật toán dùng cái dic thứ hai dựa trên giả sử mục đích của đề bài là phân tích tìm các mã bị lặp lại, tức là con số này nhỏ so với số mã. Theo giả sử này thì cái dic thứ hai rất nhỏ, vòng lặp xuất sẽ hiệu quả hơn vì chỉ phải tham chiếu cái dic nhỏ trước khi cần phải tham chiếu cái dic lớn. Nếu giả sử này sai thì cái dic thứ hai chỉ giúp cho code dễ đọc hơn chứ phần hiệu quả thì chỉ là trung bình.
Thuật toán bài này giảm thiểu được số lần ghi keys trong dic. Nhưng cũng phải ghi lại item (phần có "/". Phần đếm số lần lặp lại thì thuật toán nào cũng phải làm). So sánh với thuật toán dùng 2 dics thì có thể lợi hơn nếu số mã có lặp lại nhiều gần bằng số mã. Nếu số mã lặp lại rất ít so với số mã thì dùng 2 dics gọn hơn.
Bài #26:
Thuật toán này khong khác dùng 2 dics. Tuy nó giảm được cái dic thứ hai nhưng cũng làm cho cái mục lục của dic lớn hơn (xem lưu ý bên dưới).
Lưu ý là thuật toán dùng cái dic thứ hai dựa trên giả sử mục đích của đề bài là phân tích tìm các mã bị lặp lại, tức là con số này nhỏ so với số mã. Theo giả sử này thì cái dic thứ hai rất nhỏ, vòng lặp xuất sẽ hiệu quả hơn vì chỉ phải tham chiếu cái dic nhỏ trước khi cần phải tham chiếu cái dic lớn. Nếu giả sử này sai thì cái dic thứ hai chỉ giúp cho code dễ đọc hơn chứ phần hiệu quả thì chỉ là trung bình.
Upvote
0
Góp thêm code dùng 1 Dic và 1 Key, với Item là 1 mảng gồm 2 phần tử: Đếm số lần lặp lại và số thứ tự
Mã:
Sub GPE()
Dim Arr(), Darr(), i As Long, K As Long, Key As String
Darr = Range("R19", Range("R60000").End(xlUp)).Value
ReDim Arr(1 To UBound(Darr), 1 To 1)
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Darr)
If Darr(i, 1) <> Empty Then
Key = Darr(i, 1)
If Not .Exists(Key) Then 'Gán Key khong trùng
.Item(Key) = 1
ElseIf IsNumeric(.Item(Key)) Then 'Neu dieu kien thoa, tao so thu tu k
K = K + 1
.Item(Key) = Array(2, K) 'Gán mang Item(dem so lan lap lai cua Ma , so thu tu)
Else 'tang bien dem so lan lap lai cua ma
.Item(Key) = Array(.Item(Key)(0) + 1, .Item(Key)(1))
End If
End If
Next i
For i = 1 To UBound(Darr)
If Darr(i, 1) <> Empty Then
Key = Darr(i, 1) 'Key dung de lay ket qua va so thu tu
If Not IsNumeric(.Item(Key)) Then Arr(i, 1) = "'" & .Item(Key)(1) & "/" & .Item(Key)(0)
End If
Next i
End With
Range("S19").Resize(i - 1) = Arr
End Sub
Upvote
0
Khi dùng hàm Array cần phải để ý cái LBound của kết quả. Bởi vì nó tùy thuộc vào Option Base.
Một số hàm trong VBA có thuộc tính được mặc định theo môi trường. Hàm Array là một trong những hàm này.
Tuy nhiên, đói với nhóm hàm này, MS cũng cho phép bạn viết code không tùy thuộc môi trường - đó là cách dùng tiền tố thư viện (library namespace)
Tiền tố VBA sẽ buộc hàm Array đi theo mặc định ngôn ngữ và tách biệt khỏi ảnh hưởng môi trường. Cách dùng: VBA.Array(...)
Thử code sau sẽ rõ hơn
Option Base 1
Sub t()
a = Array(1, 2)
b = VBA.Array(1, 2)
Debug.Print LBound(a), LBound(b) ' in ra 1 và 0
End Sub
Upvote
0
Cám ơn bạn nhiều, chúc bạn và gia đình luôn vui, khỏe
Upvote
0
Thật ra có một sự khác biệt về kết quả giữa giải thuật "đặt số thứ tự trước" (bài #24, #26, #28) và giải thuật "đặt số thứ tự sau" (bài #25)
Giải thuật 1 sẽ đặt số 1 cho mã đầu tiên mà nó nhận ra là có lặp lại. Giải thuật 2 sẽ đặt số 1 cho mã đầu tiên trong dữ liệu và có lặp lại.
Vì đề bài không nêu rõ cần cái nào cho nên cả hai đều đạt.
Giải thuật 1 sẽ đặt số 1 cho mã đầu tiên mà nó nhận ra là có lặp lại. Giải thuật 2 sẽ đặt số 1 cho mã đầu tiên trong dữ liệu và có lặp lại.
Vì đề bài không nêu rõ cần cái nào cho nên cả hai đều đạt.
Upvote
0
