hamhochoi66
Thành viên chính thức
- Tham gia
- 17/4/12
- Bài viết
- 72
- Được thích
- -15
- Giới tính
- Nam
lấy một phần ký tự trong chuỗi (không có quy luật) để làm trị dò,
Tmp | Mã công trình | |||||||
công trình Nâng cấp và phát triển lưới điện khu vực Điện lực Cái Bè | No | |||||||
Nâng cấp & phát triển lưới điện khu vực Điện lực Gò Công Đông, Tân Phú Đông | No | |||||||
TBA 110kV KCN Vĩnh Hảo & ĐD đấu nối tỉnh Bình Thuận | No | |||||||
Lộ ra 110kV từ trạm 220kV Phước Long (2 mạch) | ; 20ALD014 |
Có phải bạn đang đợi kết quả vầy, phải không?
Tmp Mã công trình công trình Nâng cấp và phát triển lưới điện khu vực Điện lực Cái Bè No Nâng cấp & phát triển lưới điện khu vực Điện lực Gò Công Đông, Tân Phú Đông No TBA 110kV KCN Vĩnh Hảo & ĐD đấu nối tỉnh Bình Thuận No Lộ ra 110kV từ trạm 220kV Phước Long (2 mạch) ; 20ALD014
Sub TimKiem()
Dim Rng As Range, sRng As Range, Cls As Range
Dim Rws As Long: Dim MyAdd As String
Sheets("Quy").Select
With Sheets("MCT")
Rws = .[B2].CurrentRegion.Rows.Count
Set Rng = .[B1].Resize(Rws)
For Each Cls In Range([B2], [B2].End(xlDown))
Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
If sRng Is Nothing Then
Cls.Offset(, 1).Value = "No"
Else
MyAdd = sRng.Address
Do
Cls.Offset(, 1).Value = Cls.Offset(, 1).Value & "; " & sRng.Offset(, -1).Value
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
Next Cls
End With
End Sub
Không có quy luật thì theo bạn lấy gì làm chuẩn để dò tìm?Ý
Ý em làm độ dài của chuỗi á anh!Không có quy luật thì theo bạn lấy gì làm chuẩn để dò tìm?
Dạ, đúng rồi anh, tức là từ 1 phần các chữ màu đỏ dò trong danh mục để lấy mã công trình ạCó phải bạn đang đợi kết quả vầy, phải không?
Tmp Mã công trình công trình Nâng cấp và phát triển lưới điện khu vực Điện lực Cái Bè No Nâng cấp & phát triển lưới điện khu vực Điện lực Gò Công Đông, Tân Phú Đông No TBA 110kV KCN Vĩnh Hảo & ĐD đấu nối tỉnh Bình Thuận No Lộ ra 110kV từ trạm 220kV Phước Long (2 mạch) ; 20ALD014
Không thể lấy 1 phần của cả cụm từ màu đỏ đem dò. Lúc đó phải BĂM cụm màu đỏ này theo cách nàoDạ, đúng rồi anh, tức là từ 1 phần các chữ màu đỏ dò trong danh mục để lấy mã công trình ạ
Thấy các anh bạn luận sôi nổi, xin góp vui 1 chút.Dùng tên công trình để tìm mã công trình trong khi cái tên công trình đó chắc chắn là được gõ vào rất tùy tiện, không theo quy tắc nào: thích thì gõ tắt 1 cụm nào đó, ưa thì bỏ bớt 1 cụm nào đó, vui thì đúng chính tả, buồn thì trật chính tả... thì quả là 1 việc không thể.
Option Explicit
Sub Thai24h()
Dim i&, j&, Lr&, jRow&
Dim Arr(), Arr1(), KQ(), S
Dim Ws As Worksheet, Sh As Worksheet
Dim Dic As Object, Key, Tmp
Set Sh = Sheets("mct")
Lr = Sh.Cells(10000, 1).End(3).Row
Arr = Sh.Range("A2:B" & Lr).Value
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
Key = Arr(i, 2)
Dic(Key) = i
Next i
Set Ws = Sheets("quy")
jRow = Ws.Cells(10000, 1).End(3).Row
Arr1 = Ws.Range("A2:A" & jRow).Value
ReDim KQ(1 To UBound(Arr1), 1 To 1)
For i = 1 To UBound(Arr1)
For Each Key In Dic.Keys
If Arr1(i, 1) Like "*" & Key & "*" Then
KQ(i, 1) = Arr(Dic(Key), 1)
End If
Next Key
Next i
Ws.Range("C2").Resize(UBound(Arr1), 1) = KQ
End Sub
Vẫn chỉ là phương án tìm chính xác anh nhỉ?Thấy các anh bạn luận sôi nổi, xin góp vui 1 chút.
Hy vọng chủ thớt cũng giải quyết được phần nào.
Nên thường khi so là UCASE chuỗi tìm và chuỗi gốc; TRIM() các kiểu rồi đi thắp nhang, như dò lô tô.Dùng tên công trình để tìm mã công trình trong khi cái tên công trình đó chắc chắn là được gõ vào rất tùy tiện, không theo quy tắc nào: thích thì gõ tắt 1 cụm nào đó, ưa thì bỏ bớt 1 cụm nào đó, vui thì đúng chính tả, buồn thì trật chính tả... thì quả là 1 việc không thể.
Cảm ơn anh đã xem bài và góp ý.Vẫn chỉ là phương án tìm chính xác anh nhỉ?
Vì thực tế tỷ lệ chính xác hoàn toàn là 70/100 (theo file ví dụ), vẫn còn lại những trường hợp coi như chính xác:
Ví dụ:
"nâng cấp và phát triển" vs "nâng cấp & phát triển" coi như là chính xác.
"220KV" vs "220kV" vs "220 KV" vs "220 kV" cũng vậy
Đúng là chuyển hết về chữ in hoa và xóa bỏ khoảng trống thừa thì có thể tỷ lệ trúng sẽ cao hơn. Chủ thớt là người biết code nếu đọc được bài này của bạn chắc tự biết phỉa làm gì.Nên thường khi so là UCASE chuỗi tìm và chuỗi gốc; TRIM() các kiểu rồi đi thắp nhang, như dò lô tô.
Chắc là sẽ trúng.
Dạ cám ơn anh, nhưng em không rành về code ạ!Cảm ơn anh đã xem bài và góp ý.
Dữ liệu mà không chuẩn thì chỉ có máy vi tính chạy bằng cơm mới phù hợp.
Đã nói là chỉ hy vọng chủ thớt giả quyết được phần nào thôi mà. Thì được tý nào hay tý đó.
Còn rõ ràng chỉ khắc nhau 1 dấu " " thì nó cũng đã là khác rồi.
Bài đã được tự động gộp:
Đúng là chuyển hết về chữ in hoa và xóa bỏ khoảng trống thừa thì có thể tỷ lệ trúng sẽ cao hơn. Chủ thớt là người biết code nếu đọc được bài này của bạn chắc tự biết phỉa làm gì.
Mình đề xuất qui trình ngược & sẽ là:Giả sử em có file sau thì mình có thể tìm được không ạ (Dựa vào redtext ở cột A dò trong bảng màu tím để ra kết quả ở Cột C)?
Có ở các dòng | VIẾT TẮT | TÊN CÔNG TY | |||||||||||||||||||
10;9; | VIET DUNG | CÔNG TY TNHH THƯƠNG MẠI VẬN TẢI VIỆT DŨNG | |||||||||||||||||||
11;8; | VIETCO | Công ty TNHH Giao Nhận Hàng Hóa Việt Công | |||||||||||||||||||
6; | VIET CONG | Công ty TNHH Giao Nhận Hàng Hóa Việt Công | |||||||||||||||||||
2; | THAI TUAN | Công ty TNHH Tập Đoàn Thái Tuấn Logistics | |||||||||||||||||||
5; | BAO THACH | Công Ty TNHH Khoáng Sản và Xây Dựng Bảo Thạch | |||||||||||||||||||
12;3; | NHAT MY PHAT | Công Ty TNHH Nhật Mỹ Phát | |||||||||||||||||||
7;4; | NAT | CÔNG TY TNHH NAT LOGISTICS | |||||||||||||||||||
Sub TimKiem()
Dim Rng As Range, sRng As Range, Cls As Range
Dim Rws As Long: Dim MyAdd As String
Set Rng = Range([A2], [A1].End(xlDown))
For Each Cls In Range([F2], [F2].End(xlDown))
Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
If sRng Is Nothing Then
Cls.Interior.ColorIndex = 38
Else
MyAdd = sRng.Address
Do
Cls.Offset(, -1).Value = sRng.Row & ";" & Cls.Offset(, -1).Value
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
Next Cls
End Sub
Rồi sau đó tiếp theo sẽ làm như thế nào vậy thầy? Em không rành về code lắm ạ!Mình đề xuất qui trình ngược & sẽ là:
Lấy các trị trên cột 'F" đem tìm trên cột 'A'
Kết quả nếu có sẽ ghi lại chỉ số dòng của cột 'A' lên cột kề trái cột 'F':
Có ở các dòng VIẾT TẮT TÊN CÔNG TY 10;9; VIET DUNG CÔNG TY TNHH THƯƠNG MẠI VẬN TẢI VIỆT DŨNG 11;8; VIETCO Công ty TNHH Giao Nhận Hàng Hóa Việt Công 6; VIET CONG Công ty TNHH Giao Nhận Hàng Hóa Việt Công 2; THAI TUAN Công ty TNHH Tập Đoàn Thái Tuấn Logistics 5; BAO THACH Công Ty TNHH Khoáng Sản và Xây Dựng Bảo Thạch 12;3; NHAT MY PHAT Công Ty TNHH Nhật Mỹ Phát 7;4; NAT CÔNG TY TNHH NAT LOGISTICS
Bạn tham khảo:
PHP:Sub TimKiem() Dim Rng As Range, sRng As Range, Cls As Range Dim Rws As Long: Dim MyAdd As String Set Rng = Range([A2], [A1].End(xlDown)) For Each Cls In Range([F2], [F2].End(xlDown)) Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart) If sRng Is Nothing Then Cls.Interior.ColorIndex = 38 Else MyAdd = sRng.Address Do Cls.Offset(, -1).Value = sRng.Row & ";" & Cls.Offset(, -1).Value Set sRng = Rng.FindNext(sRng) Loop While Not sRng Is Nothing And sRng.Address <> MyAdd End If Next Cls End Sub
Góp vui thêm 1 phương án tham khảo.Dạ cám ơn anh, nhưng em không rành về code ạ!
Bài đã được tự động gộp:
Em cám ơn các anh chị em, thầy đã hỗ trợ em ạ! Từ lâu em luôn thắc mắc là nếu như mình chỉ lấy 1 phần trong chuỗi để làm lookup_value để dò tìm thì có được không, nhưng tìm khác trên internet không thấy ai làm về tip này. Mong các thầy chỉ giáo ạ!
Giả sử em có file sau thì mình có thể tìm được không ạ (Dựa vào redtext ở cột A dò trong bảng màu tím để ra kết quả ở Cột C)?
Sub Thai()
Dim i&, j&, t&
Dim Arr(), KQ(), S As String, Tmp As String
Dim Sh As Worksheet, Rng As Range
Set Sh = Sheet1
Arr = Sh.Range("A2:A" & Sh.Cells(100000, 1).End(3).Row).Value
Set Rng = Sh.Range("F1:G" & Sh.Range("G100000").End(3).Row)
ReDim KQ(1 To UBound(Arr), 1 To 1)
For i = 1 To UBound(Arr)
S = Empty
For j = 1 To Len(Arr(i, 1))
Tmp = Mid(Arr(i, 1), j, 1)
If Tmp <> Empty And Sh.Range("A" & i + 1).Characters(Start:=j, Length:=1).Font.Color = 255 Then
S = S & Tmp
End If
Next j
If Not Rng.Find(UCase(Trim(S))) Is Nothing Then
t = Rng.Find(UCase(Trim(S))).Row
KQ(i, 1) = Rng(t, 2)
End If
Next i
Sh.Range("C2").Resize(10000, 1).ClearContents
Sh.Range("C2").Resize(i - 1, 1) = KQ
End Sub
Code chạy ra kết quả mong muốn, quá tuyệt vời! nhưng để hiểu nó hơi khó hơn là sử dụng hàm đối với em. Cám ơn thầyrất nhiều!Góp vui thêm 1 phương án tham khảo.
Xem fileMã:Sub Thai() Dim i&, j&, t& Dim Arr(), KQ(), S As String, Tmp As String Dim Sh As Worksheet, Rng As Range Set Sh = Sheet1 Arr = Sh.Range("A2:A" & Sh.Cells(100000, 1).End(3).Row).Value Set Rng = Sh.Range("F1:G" & Sh.Range("G100000").End(3).Row) ReDim KQ(1 To UBound(Arr), 1 To 1) For i = 1 To UBound(Arr) S = Empty For j = 1 To Len(Arr(i, 1)) Tmp = Mid(Arr(i, 1), j, 1) If Tmp <> Empty And Sh.Range("A" & i + 1).Characters(Start:=j, Length:=1).Font.Color = 255 Then S = S & Tmp End If Next j If Not Rng.Find(UCase(Trim(S))) Is Nothing Then t = Rng.Find(UCase(Trim(S))).Row KQ(i, 1) = Rng(t, 2) End If Next i Sh.Range("C2").Resize(10000, 1).ClearContents Sh.Range("C2").Resize(i - 1, 1) = KQ End Sub