Gán địa chỉ cột từ bàn phím để dò tìm giá trị trùng nhau trên cột nhập vào đó (1 người xem)

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)
T

thanhthat

Thành viên chính thức
Tham gia
30/5/08
Bài viết
85
Được thích
5
Kính chào ACE GPE !

Minh có sheet1, trên sheet có số liệu, vd:

Cột
[TABLE="width: 240"]
[TR]
[TD="width: 80, align: left"]E3[/TD]
[TD="width: 80, align: left"]F3[/TD]
[TD="width: 80, align: left"]G3[/TD]
[/TR]
[TR]
[TD="align: left"]E3[/TD]
[TD="align: left"]F3[/TD]
[TD="align: left"]G3[/TD]
[/TR]
[TR]
[TD="align: left"]E4[/TD]
[TD="align: left"]F4[/TD]
[TD="align: left"]G4[/TD]
[/TR]
[TR]
[TD="align: left"]E4[/TD]
[TD="align: left"]F4[/TD]
[TD="align: left"]G4[/TD]
[/TR]
[TR]
[TD="align: left"]E5[/TD]
[TD="align: left"]F5[/TD]
[TD="align: left"]G5[/TD]
[/TR]
[TR]
[TD="align: left"]E6[/TD]
[TD="align: left"]F6[/TD]
[TD="align: left"]G6[/TD]
[/TR]
[/TABLE]
Đại khái mình có đoạn code tham khảo như sau:

Sub sbFindDuplicatesInColumn()
Dim Addres As String
Dim Rng As Range
Dim LastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long

Addres = InputBox("Enter a Search value")
LastRow = Range("Addres" & Rows.Count).End(xlUp).Row

For iCntr = 1 To LastRow
If Cells(iCntr, 1) <> "" Then
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("Addres 1:Addres" & LastRow), 0)
If iCntr <> matchFoundIndex Then
Cells(iCntr, 2).Value = Cells(iCntr, 1).Value
End If
End If
Next
End Sub

Bây giờ mình muốn nhập vào biến Addres là cột tuỳ mình nhập vào (ở đây ví dụ có thể là cột E hoặc F hoặc G) sẽ tìm các giá trị giống nhau trên cột đó từ Addres 3 đến LastRow (Như File đính kèm)

Nhờ ACE giúp mình code này với.

Thanks !
 

File đính kèm

Thử code nầy
Sub sbFindDuplicatesInColumn()
Dim Addres As String
Dim Rng As Range
Dim LastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long
Addres = InputBox("Enter a Search value")
LastRow = Range(Addres & 65000).End(xlUp).Row
For iCntr = 1 To LastRow
If Range(Addres & iCntr) <> "" Then
matchFoundIndex = WorksheetFunction.Match(Range(Addres & iCntr), Range(Addres & "1:" & Addres & LastRow), 0)
If iCntr <> matchFoundIndex Then
Cells(iCntr, 2).Value = Range(Addres & iCntr).Value
End If
End If
Next
End Sub
 
HieuCD đã viết:
Thử code nầy
Sub sbFindDuplicatesInColumn()
Dim Addres As String
Dim Rng As Range
Dim LastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long
Addres = InputBox("Enter a Search value")
LastRow = Range(Addres & 65000).End(xlUp).Row
For iCntr = 1 To LastRow
If Range(Addres & iCntr) <> "" Then
matchFoundIndex = WorksheetFunction.Match(Range(Addres & iCntr), Range(Addres & "1:" & Addres & LastRow), 0)
If iCntr <> matchFoundIndex Then
Cells(iCntr, 2).Value = Range(Addres & iCntr).Value
End If
End If
Next
End Sub
Nhấp chuột vào đây để mở rộng...
Dùng WorksheetFunction.Match là phải bẫy lỗi không tìm thấy nha!
Mà sao không dùng Find method cho khoẻ?
 
ndu96081631 đã viết:
Dùng WorksheetFunction.Match là phải bẫy lỗi không tìm thấy nha!
Mà sao không dùng Find method cho khoẻ?
Nhấp chuột vào đây để mở rộng...
chỉ sửa code cho chạy được thôi, trong trường hợp nầy do lấy dữ liệu trong cột rồi Match trong cột đó nên hên không bị lỗi. lần sau sẽ chú ý bẩy lỗi
 
HieuCD đã viết:
chỉ sửa code cho chạy được thôi, trong trường hợp nầy do lấy dữ liệu trong cột rồi Match trong cột đó nên hên không bị lỗi. lần sau sẽ chú ý bẩy lỗi
Nhấp chuột vào đây để mở rộng...
Thường thì ta nghĩ rằng do lấy dữ liệu khác rổng trong cột rồi MATCH chính trong cột đó nên không thể nào lỗi được??? Thật ra vẫn có đó! Là khi phần tử trong cột tuy khác rổng nhưng bị lỗi (lỗi NA, DIV/0 hoặc bất cứ lỗi gì...) ---> Dẫn đến MATCH bị lỗi
-----------------
Nói chung là tôi hơi cẩn thận khi viết code nên luôn cố nghĩ ra bất cứ lỗi gì có thể để bẫy nó... Đến lúc dù không còn tìm ra bất cứ lỗi nào nữa cũng cố thêm dòng On Error Resume Next vào cho chắc
Chỉ là quan điểm cá nhân, nếu không phải mong bỏ qua cho!
 
HieuCD đã viết:
chỉ sửa code cho chạy được thôi, trong trường hợp nầy do lấy dữ liệu trong cột rồi Match trong cột đó nên hên không bị lỗi. lần sau sẽ chú ý bẩy lỗi
Nhấp chuột vào đây để mở rộng...
Nhờ Bạn code theo phương thức Find method hoặc bẩy lỗi đoạn code trên giúp mình với.

Cám ơn Bạn !
 
ndu96081631 đã viết:
Thường thì ta nghĩ rằng do lấy dữ liệu khác rổng trong cột rồi MATCH chính trong cột đó nên không thể nào lỗi được??? Thật ra vẫn có đó! Là khi phần tử trong cột tuy khác rổng nhưng bị lỗi (lỗi NA, DIV/0 hoặc bất cứ lỗi gì...) ---> Dẫn đến MATCH bị lỗi
-----------------
Nói chung là tôi hơi cẩn thận khi viết code nên luôn cố nghĩ ra bất cứ lỗi gì có thể để bẫy nó... Đến lúc dù không còn tìm ra bất cứ lỗi nào nữa cũng cố thêm dòng On Error Resume Next vào cho chắc
Chỉ là quan điểm cá nhân, nếu không phải mong bỏ qua cho!
Nhấp chuột vào đây để mở rộng...

Nhờ Bạn code theo phương thức Find method hoặc bẩy lỗi đoạn code trên giúp mình với.

Cám ơn Bạn !
 
ndu96081631 đã viết:
Thường thì ta nghĩ rằng do lấy dữ liệu khác rổng trong cột rồi MATCH chính trong cột đó nên không thể nào lỗi được??? Thật ra vẫn có đó! Là khi phần tử trong cột tuy khác rổng nhưng bị lỗi (lỗi NA, DIV/0 hoặc bất cứ lỗi gì...) ---> Dẫn đến MATCH bị lỗi
-----------------
Nói chung là tôi hơi cẩn thận khi viết code nên luôn cố nghĩ ra bất cứ lỗi gì có thể để bẫy nó... Đến lúc dù không còn tìm ra bất cứ lỗi nào nữa cũng cố thêm dòng On Error Resume Next vào cho chắc
Chỉ là quan điểm cá nhân, nếu không phải mong bỏ qua cho!
Nhấp chuột vào đây để mở rộng...
cám ơn bạn, mình chưa có kinh nghiệm nên không lường trước các khả năng, mong các bạn góp ý thêm
 
thanhthat đã viết:
Nhờ Bạn code theo phương thức Find method hoặc bẩy lỗi đoạn code trên giúp mình với.
Cám ơn Bạn !
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub sbFindDupCol()
Dim Addres As String
Dim LastRow As Long
Dim MatchFoundIndex As Long
Dim iCntr As Long
Addres = InputBox("Enter a Search value")
LastRow = Range(Addres & 65000).End(xlUp).Row
'On Error Resume Next
For iCntr = 1 To LastRow
    If Not IsError(Range(Addres & iCntr)) Then
        If Range(Addres & iCntr) <> "" Then
            MatchFoundIndex = Range(Addres & 1 & ":" & Addres & LastRow). _
                Find(Range(Addres & iCntr), LookIn:=xlValues).Row
            If iCntr <> MatchFoundIndex Then Cells(iCntr, 2).Value = Range(Addres & iCntr).Value
        End If
    End If
Next
End Sub
đã bẩy lỗi bằng
If Not IsError(Range(Addres & iCntr)) Then
nên bỏ
'On Error Resume Next
không biết có bỏ sót gì không
 
HieuCD đã viết:
Mã: 
Sub sbFindDupCol()
Dim Addres As String
Dim LastRow As Long
Dim MatchFoundIndex As Long
Dim iCntr As Long
Addres = InputBox("Enter a Search value")
LastRow = Range(Addres & 65000).End(xlUp).Row
'On Error Resume Next
For iCntr = 1 To LastRow
    If Not IsError(Range(Addres & iCntr)) Then
        If Range(Addres & iCntr) <> "" Then
            MatchFoundIndex = Range(Addres & 1 & ":" & Addres & LastRow). _
                Find(Range(Addres & iCntr), LookIn:=xlValues).Row
            If iCntr <> MatchFoundIndex Then Cells(iCntr, 2).Value = Range(Addres & iCntr).Value
        End If
    End If
Next
End Sub
đã bẩy lỗi bằng
If Not IsError(Range(Addres & iCntr)) Then
nên bỏ
'On Error Resume Next
không biết có bỏ sót gì không
Nhấp chuột vào đây để mở rộng...

Cám ơn Bạn đã giúp mình rất nhiều !

1/ Bạn có thể sữa code để lấy ra đủ hết các kết quả (code trên vẫn thiếu 1 kết quả)
2/ và thêm trường hợp nữa là chỉ lấy ra 1 kết quả mà thôi.
3/ Kiểm tra khi Inputbox lỡ nhập vào tiếng việt (chẳng hạn người nhập vô tình nhập vào cột là Ê) thì code sẽ báo lỗi (File đính kèm) có cách nào kiểm tra để nhắc nhỡ mình nhập khi bị tiếng việt không ạ ?

Cám ơn !
 

File đính kèm

  • Bi loi.jpg
    Bi loi.jpg
    21.7 KB · Đọc: 34
Lần chỉnh sửa cuối:
thanhthat đã viết:
Cám ơn Bạn đã giúp mình rất nhiều !

1/ Bạn có thể sữa code để lấy ra đủ hết các kết quả (code trên vẫn thiếu 1 kết quả)
2/ và thêm trường hợp nữa là chỉ lấy ra 1 kết quả mà thôi.
3/ Kiểm tra khi Inputbox lỡ nhập vào tiếng việt (chẳng hạn người nhập vô tình nhập vào cột là Ê) thì code sẽ báo lỗi (File đính kèm) có cách nào kiểm tra để nhắc nhỡ mình nhập khi bị tiếng việt không ạ ?

Cám ơn !
Nhấp chuột vào đây để mở rộng...

Qua đây cũng thấy rõ rằng: Việc bẫy lỗi trong chuyện nhập liệu của người dùng là.. VÔ CÙNG. Chẳng ai có thể tưởng tượng được người ta sẽ nhập thứ tào lao gì để mà bẫy đâu
Vậy nên ta ngăn ngừa sai sót hiệu quả bằng cách KHÔNG CHO NGƯỜI DÙNG NHẬP LIỆU MÀ BẮT HỌ PHẢI CHỌN LỰA THÔNG QUA CÔNG CỤ NÀO ĐÓ (Chẳng hạn là CheckBox, ComboBox, Validation....) ---> Khi ấy thì mọi thứ mới nằm trong tầm khống chế được
 
ndu96081631 đã viết:
Qua đây cũng thấy rõ rằng: Việc bẫy lỗi trong chuyện nhập liệu của người dùng là.. VÔ CÙNG. Chẳng ai có thể tưởng tượng được người ta sẽ nhập thứ tào lao gì để mà bẫy đâu
Vậy nên ta ngăn ngừa sai sót hiệu quả bằng cách KHÔNG CHO NGƯỜI DÙNG NHẬP LIỆU MÀ BẮT HỌ PHẢI CHỌN LỰA THÔNG QUA CÔNG CỤ NÀO ĐÓ (Chẳng hạn là CheckBox, ComboBox, Validation....) ---> Khi ấy thì mọi thứ mới nằm trong tầm khống chế được
Nhấp chuột vào đây để mở rộng...
Anh ndu96081631

Nhờ Anh code lại 3 trường hợp dưới giúp Em với

1/ Bạn có thể sữa code để lấy ra đủ hết các kết quả (code trên vẫn thiếu 1 kết quả)
2/ và thêm trường hợp nữa là chỉ lấy ra 1 kết quả mà thôi.
3/ Kiểm tra khi Inputbox lỡ nhập vào tiếng việt (chẳng hạn người nhập vô tình nhập vào cột là Ê) thì code sẽ báo lỗi (File đính kèm) có cách nào kiểm tra để nhắc nhỡ mình nhập khi bị tiếng việt không ạ ?

Cám ơn !
 
thanhthat đã viết:
Cám ơn Bạn đã giúp mình rất nhiều !

1/ Bạn có thể sữa code để lấy ra đủ hết các kết quả (code trên vẫn thiếu 1 kết quả)
2/ và thêm trường hợp nữa là chỉ lấy ra 1 kết quả mà thôi.
3/ Kiểm tra khi Inputbox lỡ nhập vào tiếng việt (chẳng hạn người nhập vô tình nhập vào cột là Ê) thì code sẽ báo lỗi (File đính kèm) có cách nào kiểm tra để nhắc nhỡ mình nhập khi bị tiếng việt không ạ ?

Cám ơn !
Nhấp chuột vào đây để mở rộng...
đã bẩy lỗi nhập sai cột, còn 1/ và 2/ không rỏ, bạn cho ví dụ cụ thể hơn
Mã: 
Sub sbFindDupCol()
Dim Addres As String, LastRow As Long, MatchFoundIndex As Long
Dim iCntr As Long
Range("B2:B100").ClearContents
On Error Resume Next
Addres = InputBox("Enter a Search value")
Lap:
Text = Range(Addres & 20)
If Err.Number <> 0 Then
    Addres = InputBox("Enter a Search value", "Value Input is Error")
    Err.Clear
    GoTo Lap
End If
LastRow = Range(Addres & 65000).End(xlUp).Row
For iCntr = 1 To LastRow
    If Not IsError(Range(Addres & iCntr)) Then
        If Range(Addres & iCntr) <> "" Then
            MatchFoundIndex = Range(Addres & 1 & ":" & Addres & LastRow). _
                Find(Range(Addres & iCntr), LookIn:=xlValues).Row
            If iCntr <> MatchFoundIndex Then Cells(iCntr, 2).Value = Range(Addres & iCntr).Value
        End If
    End If
Next
End Sub
 
 
HieuCD đã viết:
đã bẩy lỗi nhập sai cột, còn 1/ và 2/ không rỏ, bạn cho ví dụ cụ thể hơn
Mã: 
Sub sbFindDupCol()
Dim Addres As String, LastRow As Long, MatchFoundIndex As Long
Dim iCntr As Long
Range("B2:B100").ClearContents
On Error Resume Next
Addres = InputBox("Enter a Search value")
Lap:
Text = Range(Addres & 20)
If Err.Number <> 0 Then
    Addres = InputBox("Enter a Search value", "Value Input is Error")
    Err.Clear
    GoTo Lap
End If
LastRow = Range(Addres & 65000).End(xlUp).Row
For iCntr = 1 To LastRow
    If Not IsError(Range(Addres & iCntr)) Then
        If Range(Addres & iCntr) <> "" Then
            MatchFoundIndex = Range(Addres & 1 & ":" & Addres & LastRow). _
                Find(Range(Addres & iCntr), LookIn:=xlValues).Row
            If iCntr <> MatchFoundIndex Then Cells(iCntr, 2).Value = Range(Addres & iCntr).Value
        End If
    End If
Next
End Sub
Nhấp chuột vào đây để mở rộng...

Cám ơn Bạn !
có nghĩa là trên sheet có số liệu, vd:

Cột E
[TABLE="class: cms_table, width: 240"]
[TR]
[TD="width: 80, align: left"]E3[/TD]
[/TR]
[TR]
[TD="align: left"]E3[/TD]
[/TR]
[TR]
[TD="align: left"]E3[/TD]
[/TR]
[TR]
[TD="align: left"]E4[/TD]
[TD="align: left"][/TD]
[/TR]
[TR]
[TD="align: left"]E4[/TD]
[/TR]
[TR]
[TD="align: left"]E4
E5[/TD]
[/TR]
[/TABLE]
Sau khi tìm cột E cho ra kq (theo code hiện tại) là:
[TABLE="width: 80"]
[TR]
[TD="width: 80"]E3[/TD]
[/TR]
[TR]
[TD]E3

E4
E4
[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[/TABLE]
Mình muốn Bạn sữa coed giúp mình là (2 đoạn code độc lập cho mỗi trường hợp):
1/ Code khi tìm cột E có trùng nhau sẽ lấy luôn giá trị trùng
[TABLE="width: 80"]
[TR]
[TD="width: 80"]E3[/TD]
[/TR]
[TR]
[TD]E3
E3
E4
E4
[/TD]
[/TR]
[/TABLE]
E4

2/ Code khi tìm cột E có 2 giá trị trùng nhau trở lên sẽ lấy đại diện 1 giá trị trùng
[TABLE="width: 80"]
[TR]
[TD="width: 80"]E3[/TD]
[/TR]
[TR]
[TD]E4[/TD]
[/TR]
[/TABLE]
Cám ơn !
 
Lần chỉnh sửa cuối:
thanhthat đã viết:
Cám ơn Bạn !
có nghĩa là trên sheet có số liệu, vd:

Cột E
[TABLE="class: cms_table, width: 240"]
[TR]
[TD="width: 80, align: left"]E3[/TD]
[/TR]
[TR]
[TD="align: left"]E3[/TD]
[/TR]
[TR]
[TD="align: left"]E3[/TD]
[/TR]
[TR]
[TD="align: left"]E4[/TD]
[TD="align: left"][/TD]
[/TR]
[TR]
[TD="align: left"]E4[/TD]
[/TR]
[TR]
[TD="align: left"]E4
E5[/TD]
[/TR]
[/TABLE]
Sau khi tìm cột E cho ra kq (theo code hiện tại) là:
[TABLE="width: 80"]
[TR]
[TD="width: 80"]E3[/TD]
[/TR]
[TR]
[TD]E3

E4
E4[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[/TABLE]
Mình muốn Bạn sữa coed giúp mình là (2 đoạn code độc lập cho mỗi trường hợp):
1/ Code khi tìm cột E có trùng nhau sẽ lấy luôn giá trị trùng
[TABLE="width: 80"]
[TR]
[TD="width: 80"]E3[/TD]
[/TR]
[TR]
[TD]E3
E3
E4
E4[/TD]
[/TR]
[/TABLE]
E4

2/ Code khi tìm cột E có 2 giá trị trùng nhau trở lên sẽ lấy đại diện 1 giá trị trùng
[TABLE="width: 80"]
[TR]
[TD="width: 80"]E3[/TD]
[/TR]
[TR]
[TD]E4[/TD]
[/TR]
[/TABLE]
Cám ơn !
Nhấp chuột vào đây để mở rộng...
dùng cách khác
Mã: 
'Lay gia tri trung duy nhat
Sub sbFindDupCol()
Dim Col As String, LastR As Long, Dub As Long, i As Long
Dim Dic As Object, Test, Arr, tmp()
Range("B2:B100").ClearContents
On Error Resume Next
Col = InputBox("Enter a Search value")
Lap:
Test = Range(Col & 20)
If Err.Number <> 0 Then
    Col = InputBox("Enter a Search value", "Value Input is Error")
    Err.Clear:    GoTo Lap
End If
Arr = Range(Sheet1.Range(Col & 3), Sheet1.Range(Col & 65000).End(xlDown))
ReDim tmp(1 To UBound(Arr), 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
    If Not IsError(Arr(i, 1)) Then
        If Arr(i, 1) <> "" Then
            If Not Dic.Exists(Arr(i, 1)) Then
                Dic.Add Arr(i, 1), ""
            Else
                If Dic.Item(Arr(i, 1)) <> Arr(i, 1) Then
                    k = k + 1
                    tmp(k, 1) = Arr(i, 1)
                    Dic.Item(Arr(i, 1)) = Arr(i, 1)
                End If
            End If
        End If
    End If
Next
Sheet1.Range("B2").Resize(k, 1) = tmp
Set Dic = Nothing
End Sub
Mã: 
'Lay tat ca gia tri trung
Sub FindDupCol()
Dim Col As String, LastR As Long, Dub As Long, i As Long, Test
Range("B2:B100").ClearContents
On Error Resume Next
Col = InputBox("Enter a Search value")
Lap:
Test = Range(Col & 20)
If Err.Number <> 0 Then
    Col = InputBox("Enter a Search value", "Value Input is Error")
    Err.Clear
    GoTo Lap
End If
LastR = Range(Col & 65000).End(xlUp).Row
For i = 1 To LastR
    If Not IsError(Range(Col & i)) Then
        If Range(Col & i) <> "" Then
            Dub = WorksheetFunction.CountIf(Range(Col & 1 & ":" & Col & LastR), Range(Col & i))
            If Dub > 1 Then Cells(i, 2).Value = Range(Col & i).Value
        End If
    End If
Next
End Sub
 
Lần chỉnh sửa cuối:
HieuCD đã viết:
dùng cách khác
Mã: 
'Lay tat ca gia tri trung
Sub FindDupCol()
Dim Col As String, LastR As Long, Dub As Long, i As Long, Test
Range("B2:B100").ClearContents
On Error Resume Next
Col = InputBox("Enter a Search value")
Lap:
Test = Range(Col & 20)
If Err.Number <> 0 Then
    Col = InputBox("Enter a Search value", "Value Input is Error")
    Err.Clear
    GoTo Lap
End If
LastR = Range(Col & 65000).End(xlUp).Row
For i = 1 To LastR
    If Not IsError(Range(Col & i)) Then
        If Range(Col & i) <> "" Then
            Dub = WorksheetFunction.CountIf(Range(Col & 1 & ":" & Col & LastR), Range(Col & i))
            If Dub > 1 Then Cells(i, 2).Value = Range(Col & i).Value
        End If
    End If
Next
End Sub
Nhấp chuột vào đây để mở rộng...

Nhờ Bạn giúp mình thêm đoạn code này với:
Khi ta tìm trên một cột nào đó, để lấy thêm các giá trị cùng dòng với nó thì như thế nào ?
Mình chèn thêm dòng code tô đỏ để lấy giá trị tại cột H dòng i nhưng không được, tại cột C (nhập đến C) nó lấy tất cả cột H luôn.
For i = 1 To LastR
If Not IsError(Range(Col & i)) Then
If Range(Col & i) <> "" Then
Dub = WorksheetFunction.CountIf(Range(Col & 1 & ":" & Col & LastR), Range(Col & i))
If Dub > 1 Then Cells(i, 2).Value = Range(Col & i).Value
Cells(i, 3).Value = Range("H" & i).Value ' LẤY GIÁ TRỊ (H,i) NHẬP ĐẾN CELL(1,3)
End If
End If
Next
Nhờ Bạn code chỉ lấy giá trị tại các tọa độ (H,i) bị trùng thôi để nhập đến cell(i, 3).

Thanks !
 
Lần chỉnh sửa cuối:
thanhthat đã viết:
Nhờ Bạn giúp mình thêm đoạn code này với:
Khi ta tìm trên một cột nào đó, để lấy thêm các giá trị cùng dòng với nó thì như thế nào ?
Mình chèn thêm dòng code tô đỏ để lấy giá trị tại cột H dòng i nhưng không được, tại cột C (nhập đến C) nó lấy tất cả cột H luôn.
For i = 1 To LastR
If Not IsError(Range(Col & i)) Then
If Range(Col & i) <> "" Then
Dub = WorksheetFunction.CountIf(Range(Col & 1 & ":" & Col & LastR), Range(Col & i))
If Dub > 1 Then Cells(i, 2).Value = Range(Col & i).Value
Cells(i, 3).Value = Range("H" & i).Value ' LẤY GIÁ TRỊ (H,i) NHẬP ĐẾN CELL(1,3)
End If
End If
Next
Nhấp chuột vào đây để mở rộng...
bạn sửa lại lấy cột H trong điều kiện If Dub > 1 Then
For i = 1 To LastR
If Not IsError(Range(Col & i)) Then
If Range(Col & i) <> "" Then
Dub = WorksheetFunction.CountIf(Range(Col & 1 & ":" & Col & LastR), Range(Col & i))
If Dub > 1 Then
Cells(i, 2).Value = Range(Col & i).Value
Cells(i, 3).Value = Range("H" & i).Value ' LẤY GIÁ TRỊ (H,i) NHẬP ĐẾN CELL(1,3)
End If
End If
End If
Next
 
HieuCD đã viết:
bạn sửa lại lấy cột H trong điều kiện If Dub > 1 Then
For i = 1 To LastR
If Not IsError(Range(Col & i)) Then
If Range(Col & i) <> "" Then
Dub = WorksheetFunction.CountIf(Range(Col & 1 & ":" & Col & LastR), Range(Col & i))
If Dub > 1 Then
Cells(i, 2).Value = Range(Col & i).Value
Cells(i, 3).Value = Range("H" & i).Value ' LẤY GIÁ TRỊ (H,i) NHẬP ĐẾN CELL(1,3)
End If
End If
End If
Next
Nhấp chuột vào đây để mở rộng...

Chào Bạn !

Nhờ Bạn giúp mình thêm vấn đề này với, mình muốn tìm các cell đang trống trên một cột nhập vào như trên sau đó lấy ra các địa chỉ của các cell đó với.

Cám ơn Bạn !
 
thanhthat đã viết:
Chào Bạn !

Nhờ Bạn giúp mình thêm vấn đề này với, mình muốn tìm các cell đang trống trên một cột nhập vào như trên sau đó lấy ra các địa chỉ của các cell đó với.

Cám ơn Bạn !
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub FindBlank()
Dim Col As String, LastR As Long, Dub As Long, i As Long, Test
Range("B[COLOR=#ff0000]2[/COLOR]:B100").ClearContents
On Error Resume Next
Col = InputBox("Enter a Search value")
Lap:
Test = Range(Col & 20)
If Err.Number <> 0 Then
    Col = InputBox("Enter a Search value", "Value Input is Error")
    Err.Clear
    GoTo Lap
End If
LastR = Range(Col & 65000).End(xlUp).Row
For i = [COLOR=#ff0000]2[/COLOR] To LastR
    If Not IsError(Range(Col & i)) Then
        If Range(Col & i) = "" Then    Cells(i, 2).Value = UCase(Col) & i
    End If
Next
End Sub
trả về ở cột B, với 2 là dòng đầu tiên
 
Chào Bạn !

Nhân đây nhờ Bạn code giúp mình hai vấn đề này nữa nhé !

Mình có một File rất nhiều Sheet
1/ Mình muốn lưu file mới có lựa chọn sheet, sẽ lưu file mới có danh sách lựa chọn một vài sheet trên đó, hoặc gồm tất cả các sheet (trừ sheet "Maint" điều khiển, như File kèm).

2/ Tương tự việc xóa sheet cũng vậy, có danh sách lựa chọn xóa một vài sheet hoặc chọn xóa tất cả (trừ xóa sheet Maint).


Cám ơn Bạn nhiếu !!!
 

File đính kèm

Lần chỉnh sửa cuối:
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

SA_DQ
[2] Bình luận của Copilot về các ván cờ vua
Trả lời
18
Đọc
449
SA_DQ
SA_DQ
H
Cách tính ngày kết thúc khóa học
Trả lời
2
Đọc
33
Gà Con yêu VBA
Gà Con yêu VBA
E
  • Question Question
Cách nào để sắp xếp lái xe vào list danh sách
Trả lời
3
Đọc
167
Gà Con yêu VBA
Gà Con yêu VBA
havanvinhqh
  • Đã giải quyết
Nâng cấp PM Excel để chạy mượt mà hơn
    • Ngạc nhiên
    • Cười
Trả lời
5
Đọc
295
Trần Văn Bình
T
L
  • Question Question
Viết code tìm kiếm các file trong Folder
Trả lời
68
Đọc
13K
HeSanbi
HeSanbi
ongke0711
Tạo thông báo nhắc nhở công việc (Excel + PowerShell + Task scheduler)
    • Thích
    • Yêu thích
Trả lời
16
Đọc
458
ongke0711
ongke0711
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
5 6 7
Trả lời
661
Đọc
103K
pycckuu410
pycckuu410
Trungvt3
Get data từ From file excel workbook, load to xong dữ liệu thì Định dạng bị thay đổi so với dữ liệu từ file excel
Trả lời
1
Đọc
77
ptm0412
ptm0412
phuongnam366377
Xây dựng RPC Server cho Excel / Access bằng Delphi – Tận dụng lại DLL và bảo mật mã nguồn
    • Thích
Trả lời
19
Đọc
1K
phuongnam366377
phuongnam366377
Nguyễn Duy Tuân
Hàm BS_TEXT trộn văn bản trong Excel với Add-in A-Tools v10
Trả lời
1
Đọc
494
Nguyễn Duy Tuân
Nguyễn Duy Tuân
G
  • Question Question
Xin hỏi về Lỗi Path Not Found
Trả lời
11
Đọc
233
ongke0711
ongke0711
Maika8008
Liệt kê file trong 1 thư mục của Google Drive
Trả lời
0
Đọc
91
Maika8008
Maika8008
K
Tư vấn dùng máy tính chip AMD hay Intel
Trả lời
6
Đọc
336
vuvo_nhenhang
V
Maika8008
Dùng Apps Script gửi mail hàng loạt từ Google sheets
    • Thích
    • Yêu thích
Trả lời
6
Đọc
298
befaint
befaint
Tiger Nau
In dữ liệu trong word bị lỗi
Trả lời
0
Đọc
69
Tiger Nau
Tiger Nau
J
lỗi không lưu được dữ liệu trong file excel
Trả lời
3
Đọc
127
jenny 129
J
N
  • Question Question
Một lỗi rất khó chịu của VBA khi đọc chuỗi Unicode
    • Thích
Trả lời
3
Đọc
202
ongke0711
ongke0711
nvtnet
  • Question Question
Nhờ các bác giúp đỡ tạo chương trình sao chép dữ liệu vào thư mục con
Trả lời
0
Đọc
97
nvtnet
nvtnet
GPE-Trợ Lý
[ZOOM] POWER QUERY TRAINING (LỚP HỌC POWER QUERY THÁNG 04/2026) (1 người xem)
    • Thích
Trả lời
0
Đọc
4K
GPE-Trợ Lý
GPE-Trợ Lý
minhminh27
File excel thực hiện thao tác lưu trữ (Archive) email của outlook 365
Trả lời
0
Đọc
94
minhminh27
minhminh27
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