Nhờ các bác hỗ trợ giải thuật và cả code bài toán khó (1 người xem)

aquarius8 · 27/9/22

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

GC	Line	Location	PC	Used
H2508308RV	LBSA	1	2110534R	2
H2508308RV	LBSA	2	2506002X	1
H2508308RV	LBSA	2,1	2506002V	1
H2508308RV	LBSA	2,1,1	21159-1	0.0221
H2508308RV	LBSA	2,2	2507006V	1
H2508308RV	LBSA	2,2,1	25044	0.00059
H2508308RV	LBSA	2,2,2	M00202	0.000032
H2508308RV	LBSA	3	2506028	2
H2508308RV	LBSA	4	2508308BR-1	1
H2508308RV	LBSA	4,1	2112503-1	4
H2508308RV	LBSA	4,1,1	2110503	4
H2508308RV	LBSA	4,1,2	2119088-1	4
H2508308RV	LBSA	4,1,3	2200540	4
H2508308RV	LBSA	4,2	2505555R	2
H2508308RV	LBSA	4,3	2506001GC	1
H2508308RV	LBSA	4,3,1	P0202-1	0.02513
H2508308RV	LBSA	4,4	2506003AR	1
H2508308RV	LBSA	4,4,1	2506004R	1
H2508308RV	LBSA	4,4,1,1	2506003	1
H2508308RV	LBSA	4,4,1,2	2506009	1
H2508308RV	LBSA	4,4,1,3	2506034	1
H2508308RV	LBSA	4,4,1,4	2506035R	1
H2508308RV	LBSA	4,4,1,5	2506039	1
H2508308RV	LBSA	4,4,1,6	2506004V	1
H2508308RV	LBSA	4,4,1,6,1	P0102	0.00277
H2508308RV	LBSA	4,4,1,6,2	P0503	0.00008

anhtuanle123 · 27/9/22

đúng là khó thật, đọc ko hĩu gì luôn @@

VetMini · 27/9/22

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.

snow25 · 27/9/22

VetMini đã viết:
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.

Khó ở chỗ đuổi hình bắt chữ anh nhé.

Nhattanktnn · 28/9/22

aquarius8 đã viết:
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

GC Line Location PC Used
H2508308RV LBSA 1 2110534R
2
H2508308RV LBSA 2 2506002X
1
H2508308RV LBSA 2,1 2506002V
1
H2508308RV LBSA 2,1,1 21159-1
0.0221
H2508308RV LBSA 2,2 2507006V
1
H2508308RV LBSA 2,2,1 25044
0.00059
H2508308RV LBSA 2,2,2 M00202
0.000032
H2508308RV LBSA 3 2506028
2
H2508308RV LBSA 4 2508308BR-1
1
H2508308RV LBSA 4,1 2112503-1
4
H2508308RV LBSA 4,1,1 2110503
4
H2508308RV LBSA 4,1,2 2119088-1
4
H2508308RV LBSA 4,1,3 2200540
4
H2508308RV LBSA 4,2 2505555R
2
H2508308RV LBSA 4,3 2506001GC
1
H2508308RV LBSA 4,3,1 P0202-1
0.02513
H2508308RV LBSA 4,4 2506003AR
1
H2508308RV LBSA 4,4,1 2506004R
1
H2508308RV LBSA 4,4,1,1 2506003
1
H2508308RV LBSA 4,4,1,2 2506009
1
H2508308RV LBSA 4,4,1,3 2506034
1
H2508308RV LBSA 4,4,1,4 2506035R
1
H2508308RV LBSA 4,4,1,5 2506039
1
H2508308RV LBSA 4,4,1,6 2506004V
1
H2508308RV LBSA 4,4,1,6,1 P0102
0.00277
H2508308RV LBSA 4,4,1,6,2 P0503
0.00008

Hiểu đề nhưng không có file không làm được

HieuCD · 28/9/22

aquarius8 đã viết:
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

GC Line Location PC Used
H2508308RV LBSA 1 2110534R
2
H2508308RV LBSA 2 2506002X
1
H2508308RV LBSA 2,1 2506002V
1
H2508308RV LBSA 2,1,1 21159-1
0.0221
H2508308RV LBSA 2,2 2507006V
1
H2508308RV LBSA 2,2,1 25044
0.00059
H2508308RV LBSA 2,2,2 M00202
0.000032
H2508308RV LBSA 3 2506028
2
H2508308RV LBSA 4 2508308BR-1
1
H2508308RV LBSA 4,1 2112503-1
4
H2508308RV LBSA 4,1,1 2110503
4
H2508308RV LBSA 4,1,2 2119088-1
4
H2508308RV LBSA 4,1,3 2200540
4
H2508308RV LBSA 4,2 2505555R
2
H2508308RV LBSA 4,3 2506001GC
1
H2508308RV LBSA 4,3,1 P0202-1
0.02513
H2508308RV LBSA 4,4 2506003AR
1
H2508308RV LBSA 4,4,1 2506004R
1
H2508308RV LBSA 4,4,1,1 2506003
1
H2508308RV LBSA 4,4,1,2 2506009
1
H2508308RV LBSA 4,4,1,3 2506034
1
H2508308RV LBSA 4,4,1,4 2506035R
1
H2508308RV LBSA 4,4,1,5 2506039
1
H2508308RV LBSA 4,4,1,6 2506004V
1
H2508308RV LBSA 4,4,1,6,1 P0102
0.00277
H2508308RV LBSA 4,4,1,6,2 P0503
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

aquarius8 · 28/9/22

HieuCD đã viết:

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.

SA_DQ · 28/9/22

HieuCD đã viết:
Lần sau nên gởi file

Mã:

Option Explicit

Bao chừ cho đến tháng Mười!
→ ← → ← → ← → ← → ← → ← → ← → ← → ← → ← → ← → ← → ← → ←

bebo021999 · 29/9/22

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

aquarius8 · 30/9/22

bebo021999 đã viết:

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!

Nhờ các bác hỗ trợ giải thuật và cả code bài toán khó (1 người xem)

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

aquarius8

Thành viên mới

anhtuanle123

Thành viên thường trực

VetMini

Ăn cùng góc phố

snow25

Thành viên gạo cội

Nhattanktnn

Thành viên gắn bó

HieuCD

Chuyên gia GPE

File đính kèm

aquarius8

Thành viên mới

SA_DQ

/(hông là gì!

bebo021999

Thành viên gạo cội

File đính kèm

aquarius8

Thành viên mới

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

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

Đếm ngược thời gian