Một bài toán dò tìm và nối chuổi
- Thread starter ndu96081631
- Ngày gửi
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,930
Nhập liệu không chuẩn chỉ tổ gây khó khăn thôi
Xem hình:
Nếu chuyển được cách bố trí dữ liệu như tôi nói trong hình thì mọi chuyển xem như đã được giải quyết
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,930
Họ không chịu nghe là việc của họ... cuối cùng, nếu muốn xử lý, ta tự mình chuyển sang cơ sở dữ liệu chuẩn trước vậy
Tường_Vi
Thành viên tiêu biểu
- Tham gia
- 19/4/10
- Bài viết
- 482
- Được thích
- 121
- Nghề nghiệp
- Luôn tìm kiếm một vị trí tốt hơn
Mình có thể dùng UDF để làm dạng trên không?
PHP:
Sub Transfer(sRng1 As Range, sRng2 As Range, Target As Range)
Dim sArr1, sArr2, i As Long, j As Long, iR As Long, iC As Long
Dim Arr(1 To 60000, 1 To 200), Tmp1, Tmp2, Dic1, Dic2
Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
sArr1 = sRng1: sArr2 = sRng2
For i = LBound(sArr1, 1) To UBound(sArr1, 1)
For j = LBound(sArr1, 2) To UBound(sArr1, 2)
If sArr1(i, j) <> "" Then
Tmp1 = sArr1(i, j)
Tmp2 = sArr2(i, j)
If Not Dic1.Exists(Tmp1) Then
iR = iR + 1
Dic1.Add Tmp1, iR
Dic2.Add Tmp1, 2
Arr(iR, 1) = Tmp1
Arr(iR, 2) = Tmp2
Else
Dic2.Item(Tmp1) = Dic2.Item(Tmp1) + 1
Arr(Dic1.Item(Tmp1), Dic2.Item(Tmp1)) = Tmp2
End If
If iC < Dic2.Item(Tmp1) Then iC = Dic2.Item(Tmp1)
End If
Next
Next
Target.Resize(iR, iC).Value = Arr
End Sub
PHP:
Sub Main()
Dim sRng1 As Range, sRng2 As Range, Target As Range
Set sRng1 = Range("A3:A100")
Set sRng2 = Range("C3:C100")
Set Target = Range("G2")
Transfer sRng1, sRng2, Target
End SubThưa thày sao lại cần dòng
PHP:
Transfer sRng1, sRng2, Target
- Tham gia
- 4/6/06
- Bài viết
- 901
- Được thích
- 2,714
Sub Transfer được viết dưới dạng tổng quát và Sub Main chính là sub chính để chạy. Khi bạn chạy sub Main, nó sẽ nạp giá trị cho sRng1, sRng2, Target rồi nó sẽ gọi sub Transfer và truyền tham số vào nó.
Bạn muốn hiểu thêm thì bạn chạy thử sub Transfer xem có chạy được không là biết, rồi bạn thử chạy từ từ sub Main bằng F8 xem cách nó liên kết với nhau thế nào.
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,930
Nếu cảm thấy không cần thì bạn có thể xóa bớt rồi chạy code xem nó "ra" cái gì?
Ẹc... Ẹc...
Cũng giống như ta nói rằng: Muốn xài hàm COUNTIF thì phải có vùng dữ liệu (Range) và điều kiện (Criteria)
Giờ bạn đã gõ dữ liệu vào 1 vùng nó đó rồi (tưc đã có Range) và cũng đã gõ điều kiện vào 1 cell nào đó rồi (tức đã có Criteria)... Vậy đến đây rồi.. thôi à? Hổng gọi hàm COUNTIF bằng cách đưa vùng dữ liệu và điều kiện vừa gõ vào thì nó "ra" bằng cách nào đây?
Theo ví dụ minh họa trên, bạn có thể mường tượng Sub Transfer như hàm COUNTIF còn sRng1, sRng2, Target là các đối số của nó ---> Khi đã có đối số rồi thì bạn phải gọi hàm chứ (bằng dòng lệnh Transfer sRng1, sRng2, Target)... Hổng gọi lấy cái giống gì để ra kết quả
Bài này hay quá, Item(Dic1) chạy đánh dấu theo chiều dọc, Item(Dic2) chạy đánh dấu theo chiều ngang
iR sẽ được xác định dựa vào điều kiện Dictionary, tuy vậy iC thì cận trên của nó xác định ở đâu nhỉ?
Em định sửa thành như thế này thì "tèo" nhưng chưa tìm ra nguyên nhân, mong các thày chỉ cho
--------
----> Nghĩa là hầu như bài nào mà đầu ra bố trí theo kiểu 2 chiều ngang, dọc của hình chữ nhật chắc là phải dùng 2 Dictionary?
iR sẽ được xác định dựa vào điều kiện Dictionary, tuy vậy iC thì cận trên của nó xác định ở đâu nhỉ?
Em định sửa thành như thế này thì "tèo" nhưng chưa tìm ra nguyên nhân, mong các thày chỉ cho
PHP:
Sub Transfer(sRng1 As Range, sRng2 As Range, Target As Range)
Dim sArr1, sArr2, i As Long, iR As Long, iC As Long
Dim Arr(1 To 60000, 1 To 200), Tmp1, Tmp2, Dic1, Dic2
Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
sArr1 = sRng1: sArr2 = sRng2
For i = LBound(sArr1, 1) To UBound(sArr1, 1)
If sArr1(i, 1) <> "" Then
Tmp1 = sArr1(i, 1)
Tmp2 = sArr2(i, 1)
If Not Dic1.Exists(Tmp1) Then
iR = iR + 1
Dic1.Add Tmp1, iR
Dic2.Add Tmp1, 2
Arr(iR, 1) = Tmp1
Arr(iR, 2) = Tmp2
Else
Dic2.Item(Tmp1) = Dic2.Item(Tmp1) + 1
Arr(Dic1.Item(Tmp1), Dic2.Item(Tmp1)) = Tmp2
End If
If iC = 1 Then iC = Dic2.Item(Tmp1)
End If
Next
Target.Resize(iR, iC).Value = Arr
End Sub
PHP:
Sub Main()
Dim sRng1 As Range, sRng2 As Range, Target As Range
Set sRng1 = Range("A3:A100")
Set sRng2 = Range("C3:C100")
Set Target = Range("G2")
Transfer sRng1, sRng2, Target
End Sub----> Nghĩa là hầu như bài nào mà đầu ra bố trí theo kiểu 2 chiều ngang, dọc của hình chữ nhật chắc là phải dùng 2 Dictionary?
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,930
Người ta xác định "độ rộng" lớn nhất của Arr bằng dòng này:
If iC < Dic2.Item(Tmp1) Then iC = Dic2.Item(Tmp1)
Tức cứ đem iC so sanh với Dic2.Item(Tmp1), nếu nhỏ hơn thì gán Dic2.Item(Tmp1) vào iC ---> Dẫn đến iC sẽ là số lớn nhất
Còn bạn thì lại ghi:
If iC = 1 Then iC = Dic2.Item(Tmp1) ----> Từ đầu đến cuối, iC có khi nào bằng 1 đâu nên iC cũng sẽ không bao giờ = Dic2.Item(Tmp1)
Mà cho dù iC có = Dic2.Item(Tmp1) thì cũng chưa chắc iC sẽ là số lớn nhất... Dẫn đến khi trích ra sẽ bị thiếu dữ liệu
Em hiểu rồi ah, nhầm lẫn cơ bản quá, bởi không để ý đến dòng Arr(iR,1)=Tmp1 nên em cứ tự hỏi cột đầu tiên của Arr được xác định bởi đâu, cảm ơn thày Ndu rất nhiều.
iC nó chỉ là phần mở rộng thêm thôi chứ nó không phải là độ rộng của Arr (không bao gồm cột 1)
iC nó chỉ là phần mở rộng thêm thôi chứ nó không phải là độ rộng của Arr (không bao gồm cột 1)
Lần chỉnh sửa cuối:
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,930
Nhân đây, bạn thử nghiên cứu xem có cách nào chỉ dùng 1 biến Dic mà vẫn làm được bài này không?
Ẹc... Ẹc...
(lại thêm 1 người nữa tiến bộ nhanh trong lĩnh vực lập trình đây... Cố lên..)
Vấn đề là chịu nghiên cứu, chịu "vọc". Có thầy như NDU thì không tiến bộ mới lạ.
Rất cám ơn NDU về Dic. Mình là 1 trong những người học hỏi đâu tiên về Dic từ NDU đó.
Em chưa có kinh nghiệm lắm, đôi khi viết xong Code kiểm soát đúng sai vẫn còn hạn chế, em làm thế này cũng chạy nhưng kết quả không đúng, rất mong được thày và mọi người chỉ cho em chỗ sai
PHP:
Sub Transfer(sRng1 As Range, sRng2 As Range, Target As Range)
Dim sArr1, sArr2, Arr, Dic1, Dic2, i As Long, iR As Long, iC As Long, Tmp1, Tmp2
Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
sArr1 = sRng1
sArr2 = sRng2
ReDim Preserve Arr(1 To UBound(sArr1, 1), 1 To 100)
For i = 1 To UBound(sArr1, 1)
If sArr1(i, 1) <> "" And Not Dic1.Exists(sArr1(i, 1)) Then
Tmp1 = sArr1(i, 1)
Tmp2 = sArr2(i, 1)
iR = iR + 1
Dic1.Add Tmp1, iR
Dic2.Add Tmp1, 2
Arr(iR, 1) = Tmp1
Arr(iR, 2) = Tmp2
Else
Dic2.Item(Tmp1) = Dic2.Item(Tmp1) + 1
Arr(iR, Dic2.Item(Tmp1)) = Tmp2
End If
If iC < Dic2.Item(Tmp1) Then iC = Dic2.Item(Tmp1)
Next
Target.Resize(iR, iC).Value = Arr
End Sub
PHP:
Sub Main()
Dim sRng1 As Range, sRng2 As Range, Target As Range
Set sRng1 = Range("A3:A100")
Set sRng2 = Range("C3:C100")
Set Target = Range("G2")
Transfer sRng1, sRng2, Target
End Sub- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,930
Sai nhiều chổ quá! Code đúng là:
Mã:
Sub Transfer(sRng1 As Range, sRng2 As Range, Target As Range)
Dim sArr1, sArr2, Arr(), Dic1, Dic2, i As Long, iR As Long, iC As Long, Tmp1, Tmp2
Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
sArr1 = sRng1
sArr2 = sRng2
[COLOR=#ff0000] ReDim Arr(1 To UBound(sArr1, 1), 1 To 100)[/COLOR]
For i = 1 To UBound(sArr1, 1)
[COLOR=#ff0000]If sArr1(i, 1) <> "" Then
Tmp1 = sArr1(i, 1)
Tmp2 = sArr2(i, 1)
If Not Dic1.Exists(sArr1(i, 1)) Then[/COLOR]
iR = iR + 1
Dic1.Add Tmp1, iR
Dic2.Add Tmp1, 2
Arr(iR, 1) = Tmp1
Arr(iR, 2) = Tmp2
Else
Dic2.Item(Tmp1) = Dic2.Item(Tmp1) + 1
Arr([COLOR=#ff0000]Dic1.Item(Tmp1)[/COLOR], Dic2.Item(Tmp1)) = Tmp2
End If
If iC < Dic2.Item(Tmp1) Then iC = Dic2.Item(Tmp1)
End If
Next
[COLOR=#ff0000] If iR Then [/COLOR]Target.Resize(iR, iC).Value = Arr
End Sub
Lần chỉnh sửa cuối:
Không có thày chỉ bảo chắc em không thể tự tìm chỗ sai được, từ sáng làm đi làm lại cứ nghĩ tại sao thuật toán đúng mà kết quả lại sai, nguyên nhân nhận thức sai ở 2 điểm:
1) Không nên dùng
mà phải là thế này mới chuẩn
---> Dùng gộp nhiều lúc nguy hiểm quá ----> đa số trường hợp viết gộp là đúng, một số trường hợp cá biệt cần tách ra làm 2 câu lệnh.
2) Quan niệm nhầm iR và Dic1.Item(Tmp1) nó là 1, tưởng viết thế cho gọn; nhưng nó chỉ bằng nhau trong trường hợp Not Dic.Exists thôi, trường hợp còn lại (Else) thì nó độc lập nhau.
Từ hôm qua em học được ở thày được rất nhiều kiến thức, cảm ơn thày rất nhiều.
1) Không nên dùng
PHP:
If sArr1(i, 1) <> "" And Not Dic1.Exists(sArr1(i, 1)) Then
Tmp1 = sArr1(i, 1)
Tmp2 = sArr2(i, 1)
PHP:
If sArr1(i, 1) <> "" Then
Tmp1 = sArr1(i, 1)
Tmp2 = sArr2(i, 1)
If Not Dic1.Exists(sArr1(i, 1)) Then
........---> Dùng gộp nhiều lúc nguy hiểm quá ----> đa số trường hợp viết gộp là đúng, một số trường hợp cá biệt cần tách ra làm 2 câu lệnh.
2) Quan niệm nhầm iR và Dic1.Item(Tmp1) nó là 1, tưởng viết thế cho gọn; nhưng nó chỉ bằng nhau trong trường hợp Not Dic.Exists thôi, trường hợp còn lại (Else) thì nó độc lập nhau.
Từ hôm qua em học được ở thày được rất nhiều kiến thức, cảm ơn thày rất nhiều.
Lần chỉnh sửa cuối:
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,930
Phân tích được chổ sai là bạn quá giỏi rồi còn gì
Bảo đảm 1 năm sau, GPE sẽ có thêm 1 đại cao thủ là.. bạn (nếu như bạn vẫn chăm chỉ nghiên cứu như bây giờ)
Ẹc... Ẹc...
Thưa thày Ndu, bài này có thể dùng 1 Dic làm ra được không ah, em nghĩ làm mãi chưa có kết quả , nếu sửa thành thế này thì thực ra kết quả vẫn đúng, nhưng trên cùng 1 hàng kết quả ra nó không liên tục,
---> như vậy coi như chưa đạt yêu cầu
Rất mong thày làm giúp cách chỉ có 1 Dic để em có điều kiện học hỏi
PHP:
Sub Transfer(sRng1 As Range, sRng2 As Range, Target As Range)
Dim sArr1, sArr2, Arr(), Dic1, Dic2, i As Long, iR As Long, iC As Long, Tmp1, Tmp2, j As Long
Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
sArr1 = sRng1
sArr2 = sRng2
ReDim Arr(1 To UBound(sArr1, 1), 1 To 100)
For i = 1 To UBound(sArr1, 1)
If sArr1(i, 1) <> "" Then
Tmp1 = sArr1(i, 1)
Tmp2 = sArr2(i, 1)
If Not Dic1.Exists(sArr1(i, 1)) Then
iR = iR + 1
Dic1.Add Tmp1, iR
j = 2
Arr(iR, 1) = Tmp1
Arr(iR, j) = Tmp2
Else
j = j + 1
Arr(Dic1.Item(Tmp1), j) = Tmp2
End If
If iC < j Then iC = j
End If
Next
If iR Then Target.Resize(iR, iC).Value = Arr
End Sub
Sub Main()
Dim sRng1 As Range, sRng2 As Range, Target As Range
Set sRng1 = Range("A3:A100")
Set sRng2 = Range("C3:C100")
Set Target = Range("G2")
Transfer sRng1, sRng2, Target
End Sub---> như vậy coi như chưa đạt yêu cầu
Rất mong thày làm giúp cách chỉ có 1 Dic để em có điều kiện học hỏi
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,930
Để ý code gốc, ta có Item của Dic1 lưu vị trí dòng và Item của Dic2 lưu vị trí cột
Giờ nếu bỏ bớt Dic2 thì bạn phải tìm "chổ khác" mà lưu vị trí cột thôi (là 1 mảng tạm chẳng hạn)
Tiếp tục nghiên cứu đi
Ẹc... Ẹc...
