Cần viết Code dạng Scripting.Dictionary (Chọn ra danh sách các số không trùng nhau) (1 người xem)

Elx Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
hung2412

hung2412

Thành viên tích cực
Tham gia
5/8/08
Bài viết
934
Được thích
240
Giới tính
Nam
Xin chào các Anh chị và các bạn GPE!
Nhờ các Anh chị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tôi có một bảng tính như vầy:
GZDDIfH.png


Từ cột B tôi chọn ra danh sách các số không trùng nhau và dán vào cột D như vầy:

N893Sax.png


=> Vấn đề được đặt ra ở đây là: Có Code nào dạng như vầy:
PHP: 
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
...

để thực hiện công việc trên hay không?
Mong các Anh chị và các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
hung2412 đã viết:
Xin chào các Anh chị và các bạn GPE!
Nhờ các Anh chị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tôi có một bảng tính như vầy:
Từ cột B tôi chọn ra danh sách các số không trùng nhau và dán vào cột D như vầy:

=> Vấn đề được đặt ra ở là: Có Code nào dạng như vầy:
PHP: 
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
...

để thực hiện công việc trên hay không?
Mong các Anh chị và các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.
Nhấp chuột vào đây để mở rộng...


PHP: 
Public Sub GPE()
Dim Rng()
Dim ARR()
Dim Temp As String
Dim i As Long
Dim Dem As Long
Rng = Sheet1.Range("B3:B" & Sheet1.Range("B60000").End(xlUp).Row)
ReDim ARR(1 To UBound(Rng, 1), 1 To 1) 
   Temp = ""    
    For i = 1 To UBound(Rng, 1) 
       If (InStr(Temp, Rng(i, 1)) = 0) Then   
          Temp = Temp & "," & Rng(i, 1)       
          Dem = Dem + 1            
         ARR(Dem, 1) = Rng(i, 1)
     End If
  Next  Sheet1.Range("E3").Resize(Dem, 1) = ARR
End Sub

Cứ từ từ tham khảo và tự thêm bớt các điều khoản phụ đi
 
Lần chỉnh sửa cuối:
Upvote 0
hung2412 đã viết:
Xin chào các Anh chị và các bạn GPE!
Nhờ các Anh chị và các bạn giúp đỡ cho tôi vấn đề này với
Mã: 
Sub Dic()
Dim Sarr, Arr, i As Long
Sarr = Range([B3], [B65000].End(xlUp)).Resize(, 1).Value2
ReDim Arr(1 To UBound(Sarr, 1), 1 To 1)
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Sarr, 1)
        If Not .exists(Sarr(i, 1)) Then
            .Add Sarr(i, 1), k
            k = k + 1
            Arr(k, 1) = Sarr(i, 1)
        End If
    Next
End With
    [D3:D65000].ClearContents
    [D3].Resize(UBound(Sarr, 1), 1).Value = Arr
    [D3].Resize(UBound(Sarr, 1), 1).Sort key1:=[D3], order1:=xlAscending
End Sub
Bạn thử đoạn này xem sao
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
phihndhsp đã viết:
PHP: 
Public Sub GPE()
Dim Rng()
Dim ARR()
Dim Temp As String
Dim i As Long
Dim Dem As Long
Rng = Sheet1.Range("B3:B" & Sheet1.Range("B60000").End(xlUp).Row)
ReDim ARR(1 To UBound(Rng, 1), 1 To 1) 
   Temp = ""    
    For i = 1 To UBound(Rng, 1) 
       If (InStr(Temp, Rng(i, 1)) = 0) Then   
          Temp = Temp & "," & Rng(i, 1)       
          Dem = Dem + 1            
         ARR(Dem, 1) = Rng(i, 1)
     End If
  Next  Sheet1.Range("E3").Resize(Dem, 1) = ARR
End Sub

Cứ từ từ tham khảo và tự thêm bớt các điều khoản phụ đi
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn. Tuy nhiên, tôi muốn học thêm dạng Code như vầy:
PHP: 
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Không biết là bạn có Code nào dạng đó không?
 
Upvote 0
phihndhsp đã viết:
PHP: 
Public Sub GPE()
Dim Rng()
Dim ARR()
Dim Temp As String
Dim i As Long
Dim Dem As Long
Rng = Sheet1.Range("B3:B" & Sheet1.Range("B60000").End(xlUp).Row)
ReDim ARR(1 To UBound(Rng, 1), 1 To 1) 
   Temp = ""    
    For i = 1 To UBound(Rng, 1) 
       If (InStr(Temp, Rng(i, 1)) = 0) Then   
          Temp = Temp & "," & Rng(i, 1)       
          Dem = Dem + 1            
         ARR(Dem, 1) = Rng(i, 1)
     End If
  Next  Sheet1.Range("E3").Resize(Dem, 1) = ARR
End Sub

Cứ từ từ tham khảo và tự thêm bớt các điều khoản phụ đi
Nhấp chuột vào đây để mở rộng...

Code này có vẻ không ổn : với dữ liệu kiểu XXXYZT và XXX ,X,XX sẽ coi là 1
 
Upvote 0
hung2412 đã viết:
Cảm ơn bạn. Tuy nhiên, tôi muốn học thêm dạng Code như vầy:
PHP: 
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Không biết là bạn có Code nào dạng đó không?
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub Dic()
Dim Sarr, Arr, i As Long, Dic As Object
Sarr = Range([B3], [B65000].End(xlUp)).Resize(, 1).Value2
ReDim Arr(1 To UBound(Sarr, 1), 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Sarr, 1)
        If Not Dic.exists(Sarr(i, 1)) Then
            Dic.Add Sarr(i, 1), k
            k = k + 1
            Arr(k, 1) = Sarr(i, 1)
        End If
    Next
    [D3:D65000].ClearContents
    [D3].Resize(UBound(Sarr, 1), 1).Value = Arr
    [D3].Resize(UBound(Sarr, 1), 1).Sort key1:=[D3], order1:=xlAscending
Set Dic = Nothing
End Sub
Anh thử thế này xem sao nhé
 
Upvote 0
hung2412 đã viết:
Cảm ơn bạn. Tuy nhiên, tôi muốn học thêm dạng Code như vầy:
PHP: 
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Không biết là bạn có Code nào dạng đó không?
Nhấp chuột vào đây để mở rộng...

thì hướng đi giải thuật có thể tham khảo Code như bài #3 của Comet_1701 ,
Tuy nhiên nên thêm điều kiện kiểm tra thêm giá trị rỗng, hay ta nên viết thẳng [D3].resize(k) thay vì viết [D3].resize(Ubound()...),......
 
Upvote 0
hungpecc1 đã viết:
thì hướng đi giải thuật có thể tham khảo Code như bài #3 của Comet_1701 ,
Tuy nhiên nên thêm điều kiện kiểm tra thêm giá trị rỗng, hay ta nên viết thẳng [D3].resize(k) thay vì viết [D3].resize(Ubound()...),......
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub Dic()
Dim Sarr, Arr, i As Long, Dic As Object, Tmp As String
Sarr = Range([B3], [B65000].End(xlUp)).Resize(, 1).Value2
ReDim Arr(1 To UBound(Sarr, 1), 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Sarr, 1)
        Tmp = Sarr(i, 1)
        If Tmp <> 0 Then
                If Not Dic.exists(Tmp) Then
                    Dic.Add Tmp, k
                    k = k + 1
                    Arr(k, 1) = Sarr(i, 1)
                End If
        End If
    Next
    [D3:D65000].ClearContents
    [D3].Resize(k, 1).Value = Arr
    [D3].Resize(k, 1).Sort key1:=[D3], order1:=xlAscending
Set Dic = Nothing
End Sub
Chắc ý anh Hùng là vậy nè bạn hung2414
 
Upvote 0
hungpecc1 đã viết:
Code này có vẻ không ổn : với dữ liệu kiểu XXXYZT và XXX ,X,XX sẽ coi là 1
Nhấp chuột vào đây để mở rộng...
với yêu cầu của bài này thì đúng sẽ luôn luôn ra đáp số.Tôi có kèm theo " tự thêm bớt các điều khoản phụ đi" nên tác giả sẽ tự thêm vào. cái này tôi không dùng DIC để giải quyết
 
Lần chỉnh sửa cuối:
Upvote 0
Mình thì khoái chơi kiểu xúc tích ngắn gọn
PHP: 
Sub DicTo_DicNho()
Dim It, Arr()
Arr = [B3:B1000].Value
With CreateObject("Scripting.Dictionary")
    For Each It In Arr
         If It <> "" Then .Item(It) = ""
    Next
    [I3].Resize(.Count) = Application.Transpose(.keys)
End With
End Sub
 
Upvote 0
comet_1701 đã viết:
Mã: 
Sub Dic()
Dim Sarr, Arr, i As Long, Dic As Object, Tmp As String
Sarr = Range([B3], [B65000].End(xlUp)).Resize(, 1).Value2
ReDim Arr(1 To UBound(Sarr, 1), 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Sarr, 1)
        Tmp = Sarr(i, 1)
        If Tmp <> 0 Then
                If Not Dic.exists(Tmp) Then
                    Dic.Add Tmp, k
                    k = k + 1
                    Arr(k, 1) = Sarr(i, 1)
                End If
        End If
    Next
    [D3:D65000].ClearContents
    [D3].Resize(k, 1).Value = Arr
    [D3].Resize(k, 1).Sort key1:=[D3], order1:=xlAscending
Set Dic = Nothing
End Sub
Chắc ý anh Hùng là vậy nè bạn hung2414
Nhấp chuột vào đây để mở rộng...


chỗ đo đỏ tôi có cảm giác vẫn chưa hơp lý :
Mã: 
Sub Dic()
Dim Sarr, Arr, i As Long, Dic As Object, [COLOR=#ff0000][B]Tmp As String[/B][/COLOR]
Sarr = Range([B3], [B65000].End(xlUp)).Resize(, 1).Value2
ReDim Arr(1 To UBound(Sarr, 1), 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Sarr, 1)
        Tmp = Sarr(i, 1)
       [COLOR=#ff0000][B] If Tmp <> 0[/B][/COLOR] Then
                If Not Dic.exists(Tmp) Then
                    Dic.Add Tmp, k
                    k = k + 1
                    Arr(k, 1) = Sarr(i, 1)
                End If
        End If
    Next
    [D3:D65000].ClearContents
    [D3].Resize(k, 1).Value = Arr
    [D3].Resize(k, 1).Sort key1:=[D3], order1:=xlAscending
Set Dic = Nothing
End Sub
 
Upvote 0
hungpecc1 đã viết:
chỗ đo đỏ tôi có cảm giác vẫn chưa hơp lý :
Mã: 
Sub Dic()
Dim Sarr, Arr, i As Long, Dic As Object, [COLOR=#ff0000][B]Tmp As String[/B][/COLOR]
Sarr = Range([B3], [B65000].End(xlUp)).Resize(, 1).Value2
ReDim Arr(1 To UBound(Sarr, 1), 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Sarr, 1)
        Tmp = Sarr(i, 1)
       [COLOR=#ff0000][B] If Tmp <> 0[/B][/COLOR] Then
                If Not Dic.exists(Tmp) Then
                    Dic.Add Tmp, k
                    k = k + 1
                    Arr(k, 1) = Sarr(i, 1)
                End If
        End If
    Next
    [D3:D65000].ClearContents
    [D3].Resize(k, 1).Value = Arr
    [D3].Resize(k, 1).Sort key1:=[D3], order1:=xlAscending
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
If Tmp <> 0
Thay bằng <>"" có vẻ ổn hơn đúng ko anh, Hoặc Tmp(), có thể kết hợp với len nữa
 
Lần chỉnh sửa cuối:
Upvote 0
comet_1701 đã viết:
If Tmp <> 0
Thay bằng <>"" có vẻ ổn hơn đúng ko anh, Hoặc Tmp(), có thể kết hợp với len nữa
Nhấp chuột vào đây để mở rộng...

bạn sửa lại thành như sau ngắn gọn và dễ hiểu hơn nè
PHP: 
Sub Dic()
Dim Sarr, Arr, i As Long, Dic As Object, k As Long
Sarr = Range([B3], [B65000].End(xlUp)).Resize(, 1).Value2
ReDim Arr(1 To UBound(Sarr, 1), 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Sarr, 1)
        If Not Dic.exists(Sarr(i, 1)) Then
            Dic.Add Sarr(i, 1), k
            If Sarr(i, 1) <> "" Then
                k = k + 1
                Arr(k, 1) = Sarr(i, 1)
             End If
        End If
    Next
    [f3:f65000].ClearContents
    [f3].Resize(k, 1).Value = Arr
    [f3].Resize(k, 1).Sort key1:=[f3], order1:=xlAscending
Set Dic = Nothing
End Sub
 
Upvote 0
Cảm ơn các bạn đã chỉ giáo, dựa vào các bài viết ở trên tôi vừa nghĩ thêm một phương án:
[GPECODE=vb]Option Explicit
Sub Dicto()
Dim Dic As Object
Dim rng As Range
Set Dic = CreateObject("Scripting.Dictionary")
For Each rng In Range([B3], [B1000])
If rng <> "" Then
If Not Dic.exists(rng.Value) Then
Dic.Add rng.Value, Empty
End If
End If
Next
[E3].Resize(Dic.Count) = Application.Transpose(Dic.keys)
Set Dic = Nothing
End Sub[/GPECODE]
 
Upvote 0
hung2412 đã viết:
Cảm ơn các bạn đã chỉ giáo, dựa vào các bài viết ở trên tôi vừa nghĩ thêm một phương án:
[GPECODE=vb]Option Explicit
Sub Dicto()
Dim Dic As Object
Dim rng As Range
Set Dic = CreateObject("Scripting.Dictionary")
For Each rng In Range([B3], [B1000])
If rng <> "" Then
If Not Dic.exists(rng.Value) Then
Dic.Add rng.Value, Empty
End If
End If
Next
[E3].Resize(Dic.Count) = Application.Transpose(Dic.keys)
Set Dic = Nothing
End Sub[/GPECODE]
Nhấp chuột vào đây để mở rộng...
Thực ra không khác của Kiều Mạnh đâu, chỉ là cách viết khác của Dic thôi: Đêm xong rồi chuyển mảng
 
Upvote 0
Hau151978 đã viết:
Khác nhau chứ, cách của bạn Hùng sẽ chậm hơn do duyệt từng ô.
Nhấp chuột vào đây để mở rộng...
đúng rồi anh, em nói về cách viết thôi, của Mạnh Arr là mảng, còn của bạn Hùng như anh nói là duyệt qua từng ô
Mã: 
[COLOR=#0000BB][FONT=monospace]Arr [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]B3[/FONT][/COLOR][COLOR=#007700][FONT=monospace]:[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]B1000[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Value
[/FONT][/COLOR][COLOR=#007700][FONT=monospace]
    For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Each It In Arr[/FONT][/COLOR]
Mình cũng đang định nói về tốc độ , cái trên là mảng đó nên nhanh hơn cách của hùng 2412
 
Lần chỉnh sửa cuối:
Upvote 0
hung2412 đã viết:
Xin chào các Anh chị và các bạn GPE!
Nhờ các Anh chị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tôi có một bảng tính như vầy:

GZDDIfH.png


Từ cột B tôi chọn ra danh sách các số không trùng nhau và dán vào cột D như vầy:

N893Sax.png


=> Vấn đề được đặt ra ở đây là: Có Code nào dạng như vầy:
PHP: 
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
...

để thực hiện công việc trên hay không?
Mong các Anh chị và các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.
Nhấp chuột vào đây để mở rộng...
Dictionary trên diễn đàn có khá nhiều, chẳng hiểu chủ thớt hỏi Dictionary là gì hay là nhờ làm hộ không biết nữa.
 
Upvote 0
HungQuoc49 đã viết:
Dictionary trên diễn đàn có khá nhiều, chẳng hiểu chủ thớt hỏi Dictionary là gì hay là nhờ làm hộ không biết nữa.
Nhấp chuột vào đây để mở rộng...
Tôi muốn học về Dictionary nên mới hỏi thôi ạ => Đúng là Dictionary trên diễn đàn khá nhiều => Nhưng mà choáng ngợp quá (Toàn Code khủng với đề bài phức tạp).
 
Upvote 0
Tôi thấy chả có gì khủng hết DIC nó làm hết rồi,bạn có việc lấy ra mà xài. Khủng gì đâu mà khủng
 
Upvote 0
hung2412 đã viết:
Tôi muốn học về Dictionary nên mới hỏi thôi ạ => Đúng là Dictionary trên diễn đàn khá nhiều => Nhưng mà choáng ngợp quá (Toàn Code khủng với đề bài phức tạp).
Nhấp chuột vào đây để mở rộng...

Lọc duy nhất bằng Dictionary là bài toán được hỏi và trả không phải là ít, nếu với cá nhân tôi, với bài này, chắc có lẽ là sẽ đề nghị là :" Nhờ các thành viên diễn đàn giải hộ bằng Dict " sẽ thẳng thắn hơn.
 
Upvote 0
phihndhsp đã viết:
Tôi thấy chả có gì khủng hết DIC nó làm hết rồi,bạn có việc lấy ra mà xài. Khủng gì đâu mà khủng
Nhấp chuột vào đây để mở rộng...
Việc lấy ra mà xài thì cũng phải sửa Code sao cho phù hợp với File của mình đang làm => Cái này phải nghĩ => Thế tôi mới tìm hiểu từng câu lệnh xem thế nào để mà áp dụng vào bảng tính của mình (Mà cái này nhìn Code trên diễn đàn để hiểu thì không dễ đâu ạ).
 
Upvote 0
HungQuoc49 đã viết:
Lọc duy nhất bằng Dictionary là bài toán được hỏi và trả không phải là ít, nếu với cá nhân tôi, với bài này, chắc có lẽ là sẽ đề nghị là :" Nhờ các thành viên diễn đàn giải hộ bằng Dict " sẽ thẳng thắn hơn.
Nhấp chuột vào đây để mở rộng...
Nếu mà để giải bài này thì tôi đã dùng nhiều phương án khác, chỉ là để tôi tìm hiểu về Dictionary thôi ạ.
 
Upvote 0
hung2412 đã viết:
Nếu mà để giải bài này thì tôi đã dùng nhiều phương án khác, chỉ là để tôi tìm hiểu về Dictionary thôi ạ.
Nhấp chuột vào đây để mở rộng...
Phương án khác cũng chả biết thế nào, chỉ thấy phương án của bạn theo bài ví dụ này
hung2412 đã viết:
Xin chào các Anh chị và các bạn GPE!
Nhờ các Anh chị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tôi có một bảng tính như vầy:

GZDDIfH.png


Từ cột B tôi chọn ra danh sách các số không trùng nhau và dán vào cột D như vầy:

N893Sax.png


=> Vấn đề được đặt ra ở đây là: Có Code nào dạng như vầy:
PHP: 
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
...

để thực hiện công việc trên hay không?
Mong các Anh chị và các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.
Nhấp chuột vào đây để mở rộng...
Cho kết quả là hơi lạ

Vì hình như kết quả là
[TABLE="width: 109"]
[TR]
[TD]30169[/TD]
[/TR]
[TR]
[TD]30195[/TD]
[/TR]
[TR]
[TD]30357[/TD]
[/TR]
[TR]
[TD]30001[/TD]
[/TR]
[/TABLE]
---
(Tính bẳng countif)
 
Upvote 0
HungQuoc49 đã viết:
Phương án khác cũng chả biết thế nào, chỉ thấy phương án của bạn theo bài ví dụ này
Cho kết quả là hơi lạ

Vì hình như kết quả là
[TABLE="width: 109"]
[TR]
[TD]30169[/TD]
[/TR]
[TR]
[TD]30195[/TD]
[/TR]
[TR]
[TD]30357[/TD]
[/TR]
[TR]
[TD]30001[/TD]
[/TR]
[/TABLE]
---
(Tính bẳng countif)
Nhấp chuột vào đây để mở rộng...
Kết quả ở cột D là tôi tự tay đánh vào (Chẳng qua phương án nào cả) thôi mà.
 
Upvote 0
hung2412 đã viết:
Kết quả ở cột D là tôi tự tay đánh vào (Chẳng qua phương án nào cả) thôi mà.
Nhấp chuột vào đây để mở rộng...
Không hiểu lắm, vậy kết quả ví dụ trong file mà bạn đưa lên là đúng theo yêu cầu của bạn hay không vậy.
( Vì muốn kiểm chứng kết quả tính bằng countif ở bài trước )
 
Upvote 0
Có lẽ chủ thớt thiếu trách nhiệm khi đưa file đính kèm lên cho cộng đồng giải quyết.
Tôi vẫn khẳng định kết quả theo yêu cầu viết trong đầu bài là
[TABLE="width: 109"]
[TR]
[TD]30169[/TD]
[/TR]
[TR]
[TD]30195[/TD]
[/TR]
[TR]
[TD]30357[/TD]
[/TR]
[TR]
[TD]30001[/TD]
[/TR]
[/TABLE]
 
Upvote 0
HungQuoc49 đã viết:
Có lẽ chủ thớt thiếu trách nhiệm khi đưa file đính kèm lên cho cộng đồng giải quyết.
Tôi vẫn khẳng định kết quả theo yêu cầu viết trong đầu bài là
[TABLE="width: 109"]
[TR]
[TD]30169[/TD]
[/TR]
[TR]
[TD]30195[/TD]
[/TR]
[TR]
[TD]30357[/TD]
[/TR]
[TR]
[TD]30001[/TD]
[/TR]
[/TABLE]
Nhấp chuột vào đây để mở rộng...
Đầu bài là Từ cột B tôi chọn ra danh sách các số không trùng nhau và dán vào cột D (Có hình minh họa kèm theo) (Trong các số trùng nhau thì vẫn lấy số đó nhưng chỉ lấy 1 thôi ạ, như bạn nói thì 4 số mà bạn đưa là không bao gồm các số trùng nhau.)
Note: Đúng là tôi đã nói thiếu, đáng ra tôi phải nói là Từ cột B tôi chọn ra danh sách các số không trùng nhau (Bao gồm cả số trùng nhau nhưng chỉ lấy 1) và dán vào cột D => Xin lỗi bạn nhé.
 
Upvote 0
hung2412 đã viết:
Đầu bài là Từ cột B tôi chọn ra danh sách các số không trùng nhau và dán vào cột D (Có hình minh họa kèm theo) (Trong các số trùng nhau thì vẫn lấy số đó nhưng chỉ lấy 1 thôi ạ, như bạn nói thì 4 số mà bạn đưa là không bao gồm các số trùng nhau.)
Note: Đúng là tôi đã nói thiếu, đáng ra tôi phải nói là Từ cột B tôi chọn ra danh sách các số không trùng nhau (Bao gồm cả số trùng nhau nhưng chỉ lấy 1) và dán vào cột D => Xin lỗi bạn nhé.
Nhấp chuột vào đây để mở rộng...
Đúng hay sai là do bạn đưa bài và có lẽ là bạn nên xin lỗi cộng đồng đã viết code cho bạn thì đúng hơn vì tôi cũng chả viết code nào cho thớt này cả.
 
Upvote 0
Anh Hung cho em hỏi cuối cùng anh đã dùng code ntn ah? Anh cho em file hay paste code giùm em nha?
 
Upvote 0
kieu manh đã viết:
Mình thì khoái chơi kiểu xúc tích ngắn gọn
Mã: 
Sub DicTo_DicNho()
Dim It, Arr()
Arr = [B3:B1000].Value
With CreateObject("Scripting.Dictionary")
    For Each It In Arr
          [COLOR=#ff0000][B]If It <> "" Then[/B][/COLOR] .Item(It) = ""
    Next
    [I3].Resize(.Count) = Application.Transpose(.keys)
End With
End Sub
Nhấp chuột vào đây để mở rộng...

Tuy có súc tích ngắn gọn nhưng cái chiỗ tô đậm chưa hoàn toàn hiệu quả.
Lý do: mỗi ô đều phải xét trị rỗng. Nếu có 100 dòng mà chỉ 1 vài trị rỗng thì thế hơi phí.
Giải pháp: cứ để nó add tuốt luôt hết vào. Xong xuôi, cứ trị nào không muốn giữ thì remove
.Remove ""
(nhưng nếu có 100 dòng mà hết 20 rỗng thì phương pháp xét trị rỗng lại bắt đầu hiệu quả)
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

L
Tính thời gian làm việc thực tế
Trả lời
66
Đọc
14K
YenTon
Y
H
Chia sẻ file in Phiếu điều tra PCGD
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
13
Đọc
627
Phuong7686
P
GPE-Trợ Lý
  • Dán lên cao
[KHẨN] HƯỚNG VỀ ĐỒNG BÀO CHỊU ẢNH HƯỞNG CỦA BÃO YAGI - BẢO YÊN, LÀO CAI (1 người xem)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
91
Đọc
14K
SA_DQ
SA_DQ
SA_DQ
Copilot bình luận về một ván cờ vua
    • Thích
Trả lời
6
Đọc
409
SA_DQ
SA_DQ
92nguyenthanh
  • Question Question
Vba cho file nhập xuất kho (1 người xem)
Trả lời
4
Đọc
107
HUONGHCKT
H
C
Fix lỗi Application.InputBox Type:=8
    • Cười
Trả lời
25
Đọc
618
ptm0412
ptm0412
GPE-Trợ Lý
[GPE] TALK SHOW 08: GIẢI QUYẾT VẤN ĐỀ TỐI ƯU HÓA TRONG EXCEL VỚI CÔNG CỤ SOLVER
    • Thích
    • Cảm ơn
Trả lời
4
Đọc
3K
DuongLeHung
D
Gà Công Nghệ
Chế độ chính sách cho giáo viên mầm non giữ trẻ khuyết tật
Trả lời
1
Đọc
57
vanle33
vanle33
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
56
Đọc
22K
dunghtgiga
dunghtgiga
L
  • Question Question
Viết code tìm kiếm các file trong Folder (1 người xem)
Trả lời
40
Đọc
12K
lan nguyen0987
L
P
Hyperlink_Cách chuyển cả thư mục và file tổng hợp sang máy khác không bị lỗi
Trả lời
5
Đọc
108
phongvanvu
P
HeSanbi
Tiện ích Web: Tự động nhấn nút "Bỏ qua" quảng cáo Youtube
    • Thích
    • Yêu thích
Trả lời
14
Đọc
1K
ongke0711
ongke0711
ptm0412
Quá tin tưởng vào AI các thể loại
    • Cười
Trả lời
4
Đọc
218
Maika8008
Maika8008
A
  • Question Question
Không tìm được lỗi code
Trả lời
6
Đọc
159
ptm0412
ptm0412
W
Tham chiếu theo chuỗi ký tự
Trả lời
8
Đọc
314
dungpham01
D
tritv.dad
Lấy dữ liệu từ folder các tờ khai thông quan để theo dõi hiệu suất công việc. (1 người xem)
Trả lời
8
Đọc
285
BlueSphere
B
GPE-Trợ Lý
MỪNG NGÀY NHÀ GIÁO VIỆT NAM 20/11 (1 người xem)
    • Thích
Trả lời
0
Đọc
2K
GPE-Trợ Lý
GPE-Trợ Lý
SA_DQ
Xin chúc mừng các thầy cô giáo trên cộng đồng nhân 20/11
    • Thích
    • Yêu thích
Trả lời
1
Đọc
135
BuiQuangThuan
B
M
chuyển đổi số thành chữ
Trả lời
15
Đọc
371
dungpham01
D
V
Lỗi copy sheet: the name already exists.
Trả lời
7
Đọc
702
nghiabros
N
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom