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
14
Được thích
1
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​
 
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
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
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: 14
Upvote 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
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
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
Back
Top Bottom