Nhờ các bác hỗ trợ giải thuật và cả code bài toán khó

Liên hệ QC

aquarius8

Thành viên mới
Tham gia
27/9/22
Bài viết
3
Được thích
0
Em cũng mới mày mò tự học VBA 1 tháng nay, nay có ý tưởng này muốn làm mà thực sự hơi quá khả năng, mong các bác chỉ dẫn.
Các vị trí 1-4 là những PC cấu thành nên GC
Tương tự 4,1- 4,2 - 4,3 . . . cấu thành nên 4
Bây giờ em cần lọc ra các PC cuối cùng trong mỗi vị trí để lấy ra full các PC cấu thành nên GC
Dưới đây là kết quả e cần lấy ra và bảng biểu ban đầu ạ:
1
2,1,1
2,2,1
2,2,2
3
4,1,1
4,1,2
4,1,3
4,2
4,3,1
4,4
4,4,1,1
4,4,1,2
4,4,1,3
4,4,1,4
4,4,1,5
4,4,1,6,1
4,4,1,6,2

GCLineLocationPCUsed
H2508308RVLBSA12110534R
2​
H2508308RVLBSA22506002X
1​
H2508308RVLBSA2,12506002V
1​
H2508308RVLBSA2,1,121159-1
0.0221​
H2508308RVLBSA2,22507006V
1​
H2508308RVLBSA2,2,125044
0.00059​
H2508308RVLBSA2,2,2M00202
0.000032​
H2508308RVLBSA32506028
2​
H2508308RVLBSA42508308BR-1
1​
H2508308RVLBSA4,12112503-1
4​
H2508308RVLBSA4,1,12110503
4​
H2508308RVLBSA4,1,22119088-1
4​
H2508308RVLBSA4,1,32200540
4​
H2508308RVLBSA4,22505555R
2​
H2508308RVLBSA4,32506001GC
1​
H2508308RVLBSA4,3,1P0202-1
0.02513​
H2508308RVLBSA4,42506003AR
1​
H2508308RVLBSA4,4,12506004R
1​
H2508308RVLBSA4,4,1,12506003
1​
H2508308RVLBSA4,4,1,22506009
1​
H2508308RVLBSA4,4,1,32506034
1​
H2508308RVLBSA4,4,1,42506035R
1​
H2508308RVLBSA4,4,1,52506039
1​
H2508308RVLBSA4,4,1,62506004V
1​
H2508308RVLBSA4,4,1,6,1P0102
0.00277​
H2508308RVLBSA4,4,1,6,2P0503
0.00008​
 

VetMini

Ăn cùng góc phố
Tham gia
21/12/12
Bài viết
14,653
Được thích
19,421
Khó chỗ nào chưa biết.
Trước mắt đây là bài toán táo bón. Hỏi lại một câu sẽ rặn ra thêm được một chút.
 
Upvote 0

Nhattanktnn

Thành viên gắn bó
Tham gia
11/11/16
Bài viết
2,735
Được thích
3,244
Donate (Momo)
Donate
Giới tính
Nam
Em cũng mới mày mò tự học VBA 1 tháng nay, nay có ý tưởng này muốn làm mà thực sự hơi quá khả năng, mong các bác chỉ dẫn.
Các vị trí 1-4 là những PC cấu thành nên GC
Tương tự 4,1- 4,2 - 4,3 . . . cấu thành nên 4
Bây giờ em cần lọc ra các PC cuối cùng trong mỗi vị trí để lấy ra full các PC cấu thành nên GC
Dưới đây là kết quả e cần lấy ra và bảng biểu ban đầu ạ:
1
2,1,1
2,2,1
2,2,2
3
4,1,1
4,1,2
4,1,3
4,2
4,3,1
4,4
4,4,1,1
4,4,1,2
4,4,1,3
4,4,1,4
4,4,1,5
4,4,1,6,1
4,4,1,6,2

GCLineLocationPCUsed
H2508308RVLBSA12110534R
2​
H2508308RVLBSA22506002X
1​
H2508308RVLBSA2,12506002V
1​
H2508308RVLBSA2,1,121159-1
0.0221​
H2508308RVLBSA2,22507006V
1​
H2508308RVLBSA2,2,125044
0.00059​
H2508308RVLBSA2,2,2M00202
0.000032​
H2508308RVLBSA32506028
2​
H2508308RVLBSA42508308BR-1
1​
H2508308RVLBSA4,12112503-1
4​
H2508308RVLBSA4,1,12110503
4​
H2508308RVLBSA4,1,22119088-1
4​
H2508308RVLBSA4,1,32200540
4​
H2508308RVLBSA4,22505555R
2​
H2508308RVLBSA4,32506001GC
1​
H2508308RVLBSA4,3,1P0202-1
0.02513​
H2508308RVLBSA4,42506003AR
1​
H2508308RVLBSA4,4,12506004R
1​
H2508308RVLBSA4,4,1,12506003
1​
H2508308RVLBSA4,4,1,22506009
1​
H2508308RVLBSA4,4,1,32506034
1​
H2508308RVLBSA4,4,1,42506035R
1​
H2508308RVLBSA4,4,1,52506039
1​
H2508308RVLBSA4,4,1,62506004V
1​
H2508308RVLBSA4,4,1,6,1P0102
0.00277​
H2508308RVLBSA4,4,1,6,2P0503
0.00008​
Hiểu đề nhưng không có file không làm được
 
Upvote 0

HieuCD

Chuyên gia GPE
Tham gia
14/9/10
Bài viết
9,118
Được thích
20,213
Em cũng mới mày mò tự học VBA 1 tháng nay, nay có ý tưởng này muốn làm mà thực sự hơi quá khả năng, mong các bác chỉ dẫn.
Các vị trí 1-4 là những PC cấu thành nên GC
Tương tự 4,1- 4,2 - 4,3 . . . cấu thành nên 4
Bây giờ em cần lọc ra các PC cuối cùng trong mỗi vị trí để lấy ra full các PC cấu thành nên GC
Dưới đây là kết quả e cần lấy ra và bảng biểu ban đầu ạ:
1
2,1,1
2,2,1
2,2,2
3
4,1,1
4,1,2
4,1,3
4,2
4,3,1
4,4
4,4,1,1
4,4,1,2
4,4,1,3
4,4,1,4
4,4,1,5
4,4,1,6,1
4,4,1,6,2

GCLineLocationPCUsed
H2508308RVLBSA12110534R
2​
H2508308RVLBSA22506002X
1​
H2508308RVLBSA2,12506002V
1​
H2508308RVLBSA2,1,121159-1
0.0221​
H2508308RVLBSA2,22507006V
1​
H2508308RVLBSA2,2,125044
0.00059​
H2508308RVLBSA2,2,2M00202
0.000032​
H2508308RVLBSA32506028
2​
H2508308RVLBSA42508308BR-1
1​
H2508308RVLBSA4,12112503-1
4​
H2508308RVLBSA4,1,12110503
4​
H2508308RVLBSA4,1,22119088-1
4​
H2508308RVLBSA4,1,32200540
4​
H2508308RVLBSA4,22505555R
2​
H2508308RVLBSA4,32506001GC
1​
H2508308RVLBSA4,3,1P0202-1
0.02513​
H2508308RVLBSA4,42506003AR
1​
H2508308RVLBSA4,4,12506004R
1​
H2508308RVLBSA4,4,1,12506003
1​
H2508308RVLBSA4,4,1,22506009
1​
H2508308RVLBSA4,4,1,32506034
1​
H2508308RVLBSA4,4,1,42506035R
1​
H2508308RVLBSA4,4,1,52506039
1​
H2508308RVLBSA4,4,1,62506004V
1​
H2508308RVLBSA4,4,1,6,1P0102
0.00277​
H2508308RVLBSA4,4,1,6,2P0503
0.00008​
Lần sau nên gởi file
Mã:
Option Explicit
Sub ABC()
  Dim arr(), res$(), tmp$, sRow&, i&, j&, r&, k&

  arr = Range("C3", Range("C" & Rows.Count).End(xlUp)).Value
  sRow = UBound(arr, 1)
  ReDim res(1 To sRow, 1 To 1)
  For i = 1 To sRow
    j = InStrRev(arr(i, 1), ",")
    If j > 0 Then
      tmp = Mid(arr(i, 1), 1, j - 1)
      For r = 1 To i - 1
        If arr(r, 1) = tmp Then
          arr(r, 1) = Empty
          Exit For
        End If
      Next r
    Else
      arr(i, 1) = CStr(arr(i, 1))
    End If
  Next i
  For i = 1 To sRow
    If arr(i, 1) <> Empty Then
      k = k + 1
      res(k, 1) = arr(i, 1)
    End If
  Next i
  Range("G3").Resize(sRow) = res
End Sub
 

File đính kèm

  • ChiTiet.xlsm
    16.7 KB · Đọc: 13
Upvote 0

aquarius8

Thành viên mới
Tham gia
27/9/22
Bài viết
3
Được thích
0
Lần sau nên gởi file
Mã:
Option Explicit
Sub ABC()
  Dim arr(), res$(), tmp$, sRow&, i&, j&, r&, k&

  arr = Range("C3", Range("C" & Rows.Count).End(xlUp)).Value
  sRow = UBound(arr, 1)
  ReDim res(1 To sRow, 1 To 1)
  For i = 1 To sRow
    j = InStrRev(arr(i, 1), ",")
    If j > 0 Then
      tmp = Mid(arr(i, 1), 1, j - 1)
      For r = 1 To i - 1
        If arr(r, 1) = tmp Then
          arr(r, 1) = Empty
          Exit For
        End If
      Next r
    Else
      arr(i, 1) = CStr(arr(i, 1))
    End If
  Next i
  For i = 1 To sRow
    If arr(i, 1) <> Empty Then
      k = k + 1
      res(k, 1) = arr(i, 1)
    End If
  Next i
  Range("G3").Resize(sRow) = res
End Sub
Cảm ơn bác rất nhiều. E sẽ nghiền ngẫm giải thuật và code mới trong này.
 
Upvote 0

bebo021999

Thành viên gạo cội
Tham gia
26/1/11
Bài viết
4,775
Được thích
7,270
Giới tính
Nam
Nghề nghiệp
GPE
Một cách khác không dùng vòng lặp:

Mã:
Option Explicit
Sub location()
Dim lr&
lr = Cells(Rows.Count, "C").End(xlUp).Row
Range("G3:G10000").ClearContents
With Range("G3:G" & lr)
    .Formula = "=IF(SUMPRODUCT(--(SEARCH(C3,$C$3:$C$" & lr & "&C3)=1))=1,LEFT(C3&"",0,0,0,0,0"",9),""9,9,9,9,9,9"")"
    .Value = .Value
    .Sort Range("G2")
    .Replace ",0", ""
    .Replace "9,9,9,9,9,9", ""
End With
End Sub
 

File đính kèm

  • ChiTiet.xlsm
    19.8 KB · Đọc: 3
Upvote 0

aquarius8

Thành viên mới
Tham gia
27/9/22
Bài viết
3
Được thích
0
Một cách khác không dùng vòng lặp:

Mã:
Option Explicit
Sub location()
Dim lr&
lr = Cells(Rows.Count, "C").End(xlUp).Row
Range("G3:G10000").ClearContents
With Range("G3:G" & lr)
    .Formula = "=IF(SUMPRODUCT(--(SEARCH(C3,$C$3:$C$" & lr & "&C3)=1))=1,LEFT(C3&"",0,0,0,0,0"",9),""9,9,9,9,9,9"")"
    .Value = .Value
    .Sort Range("G2")
    .Replace ",0", ""
    .Replace "9,9,9,9,9,9", ""
End With
End Sub
Cảm ơn b nhiều ạ, mỗi 1 cách là thêm 1 kiến thức mới cho em!
 
Upvote 0
Web KT

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL
Top Bottom