cần giúp cách sắp xếp các đoạn có kích thước khác nhau thành 1 cây dài 6m

duc87hp · 9/3/23

e có 1 bảng dữ liệu gồm nhiều đoạn thẳng khác nhau, bây giờ muốn sắp xếp các đoạn thành 1 cây <6m (sắp xếp những đoạn dài trước, còn thừa sẽ thêm những đoạn ngắn vào sau)
Cám ơn các bác!

HeSanbi · 10/3/23

Công thức Excel khó mà đỡ nổi mục đích bạn muốn.
Bạn tham khảo mã VBA cho đơn giản.

Sao chép mã vào module và chạy thủ tục totalSizeSegmentArrange ngoài trang tính.

JavaScript:

Sub totalSizeSegmentArrange()
  Dim a, b(), z(), i, k&, j&, i0, t&, r%, v&, rg1
  a = [B4].Resize(7, 8)
  ReDim b(1 To UBound(a) * UBound(a, 2), 1 To 2)
  For Each i In a: k = k + 1: b(k, 2) = True
    If IsNumeric(i) Then If i > 0 Then b(k, 1) = i: b(k, 2) = False
  Next
  a = ArraySort(b, 1)
  Set rg1 = [B14]
  ReDim Preserve z(1 To 7, 1 To 1): j = 1
  For i = 1 To k
    If Not a(i, 2) Then
      v = rg1(9, j).Value
      If t + a(i, 1) > v Then
        For i0 = 1 To k
          If t + a(i0, 1) <= v And Not a(i0, 2) Then
            t = t + a(i0, 1): a(i0, 2) = True:
            If r + 1 > UBound(z) Then Exit For
            r = r + 1: z(r, j) = a(i0, 1)
          End If
        Next
        r = 1: j = j + 1: ReDim Preserve z(1 To 7, 1 To j): t = a(i, 1): z(r, j) = t
      Else
        t = t + a(i, 1)
        If r + 1 > UBound(z) Then
          r = 1: j = j + 1: ReDim Preserve z(1 To 7, 1 To j): t = a(i, 1): z(r, j) = t
        Else
          r = r + 1: z(r, j) = a(i, 1)
        End If
      End If
      a(i, 2) = True
    End If
  Next
  rg1.Resize(UBound(z), j).Value = z
End Sub

Private Function ArraySort(ByVal InputArray, Optional SortColumn% = 0) As Variant
  Dim lb1%, ub1&, lb2%, ub2%, i&, j&, k&
  Dim t As Variant
  On Error Resume Next
  ub2 = UBound(InputArray, 2): lb2 = LBound(InputArray, 2)
  lb1 = LBound(InputArray, 1): ub1 = UBound(InputArray, 1)
  For i = lb1 To ub1 - 1: For j = i + 1 To ub1
    If InputArray(i, SortColumn) < InputArray(j, SortColumn) Then
      For k = lb2 To ub2
          t = InputArray(j, k):InputArray(j, k) = InputArray(i, k):InputArray(i, k) = t
      Next k
    End If
  Next j, i
  ArraySort = InputArray
End Function

Nhattanktnn · 10/3/23

HeSanbi đã viết:

Công thức Excel khó mà đỡ nổi mục đích bạn muốn.
Bạn tham khảo mã VBA cho đơn giản.

Sao chép mã vào module và chạy thủ tục totalSizeSegmentArrange ngoài trang tính.

JavaScript:

Sub totalSizeSegmentArrange()
  Dim a, b(), z(), i, k&, j&, i0, t&, r%, v&, rg1
  a = [B4].Resize(7, 4)
  ReDim b(1 To UBound(a) * UBound(a), 1 To 2)
  For Each i In a: k = k + 1: b(k, 1) = i: b(k, 2) = False: Next
  a = ArraySort(b, 1)
  Set rg1 = [B14]
  ReDim Preserve z(1 To 7, 1 To 1): j = 1
  For i = 1 To k
    If Not a(i, 2) Then
      v = rg1(9, j).Value
      If t + a(i, 1) > v Then
        For i0 = 1 To k
          If t + a(i0, 1) <= v Then
            t = t + a(i0, 1): a(i0, 2) = True: r = r + 1: z(r, j) = a(i0, 1)
          End If
        Next
        r = 1: j = j + 1: ReDim Preserve z(1 To 7, 1 To j)
        t = a(i, 1): z(r, j) = t
      Else
        t = t + a(i, 1): r = r + 1: z(r, j) = a(i, 1)
      End If
      a(i, 2) = True
    End If
  Next
  rg1.Resize(UBound(z), j).Value = z
End Sub

Private Function ArraySort(ByVal InputArray, Optional SortColumn% = 0) As Variant
  Dim lb1%, ub1&, lb2%, ub2%, i&, j&, k&
  Dim t As Variant
  On Error Resume Next
  ub2 = UBound(InputArray, 2): lb2 = LBound(InputArray, 2)
  lb1 = LBound(InputArray, 1): ub1 = UBound(InputArray, 1)
  For i = lb1 To ub1 - 1: For j = i + 1 To ub1
    If InputArray(i, SortColumn) < InputArray(j, SortColumn) Then
      For k = lb2 To ub2
        If iTrim Then
          t = Trim(InputArray(j, k))
          InputArray(j, k) = Trim(InputArray(i, k))
        Else
          t = InputArray(j, k)
          InputArray(j, k) = InputArray(i, k)
        End If
        InputArray(i, k) = t
      Next k
    End If
  Next j, i
  ArraySort = InputArray
End Function

Bác Sanbi cho hỏi, cách đặt tên biến kiểu vậy (ký tự a,b,i,i0,r,t ...):

Mã:

Dim a, b(), z(), i, k&, j&, i0, t&, r%, v&, rg1

Nó không rõ ràng là biến đó của cái gì (Kiểu như người ta thường đặt là sArr, dArr, LastRow ... ). Vậy làm cách nào để khi viết một đoạn code dài (hoặc rất dài), bác có thể nhớ được những biến đã khai báo đó dùng cho cái nào mà không gây ra nhầm lẫn? (Nghĩa là không lẫn giữa "t" qua "r" hay qua "i" hay "i0" gì đó? )

HeSanbi · 10/3/23

Tôi định nghĩa các ký tự có cơ sở để viết mã, và đặt biến ngắn để dễ dàng đọc hiểu thay vì phải viết biến quá dài khiến quá trình đọc lại mất thời gian.
các biến r, c, i, j, k, n, m thường là số, các biến a, b, z thường là mảng, e, y thường gán là boolean, w, t, v, s là chuỗi, ...
Khi biến gọi lại, hoặc đồng hành thì thêm 0, 1, 2, cũng có thể là "_"
Nếu định nghĩa sẵn như vậy trong bộ nhớ, thì sẽ viết mã nhanh hơn.

Nếu bạn có lòng tin thì mã trên tôi viết nó trong 10 phút.

cantl · 10/3/23

Nhattanktnn đã viết:
Bác Sanbi cho hỏi, cách đặt tên biến kiểu vậy (ký tự a,b,i,i0,r,t ...):

Mã:

Dim a, b(), z(), i, k&, j&, i0, t&, r%, v&, rg1

Nó không rõ ràng là biến đó của cái gì (Kiểu như người ta thường đặt là sArr, dArr, LastRow ... ). Vậy làm cách nào để khi viết một đoạn code dài (hoặc rất dài), bác có thể nhớ được những biến đã khai báo đó dùng cho cái nào mà không gây ra nhầm lẫn? (Nghĩa là không lẫn giữa "t" qua "r" hay qua "i" hay "i0" gì đó? )

Mình cũng lăn tăn chỗ đặt biến. Sau khi thử đặt biến ngắn thì sau mò lỗi tè le. Thế là cần thì đặt hẳn biến dài. VD: mangnguon, mangdich, mangtemp123, ... Nhìn rất là chuối. Nói chung là mệt mỏi lắm, không pro được, sau cũng nản, lại quay lại cơ chế xin cho. :wallbash:

Nhattanktnn · 10/3/23

HeSanbi đã viết:
các biến r, c, i, j, k, n, m thường là số, các biến a, b, z thường là mảng, e, y thường gán là boolean, w, t, v, s là chuỗi, ...
Khi biến gọi lại, hoặc đồng hành thì thêm 0, 1, 2, cũng có thể là "_"

Cảm ơn bác đã chia sẻ, viết một đoạn code đơn giản thì đặt biến không là vấn đề. Nhưng viết một code phức tạp thì đúng là phải có quy định rõ ràng không lại nhầm biến này biến nọ

HeSanbi đã viết:
Nếu bạn có lòng tin thì mã trên tôi viết nó trong 10 phút.

Với khả năng VBA của bác thì không quá ngạc nhiên về vấn đề này

befaint · 10/3/23

Nhattanktnn đã viết:
quá ngạc nhiên

Bài nào dễ mình viết có 69 phút là xong (chưa biết đúng sai nhưng cứ.... nộp bài), còn dành cỡ 96+1 phút để chỉnh sửa mà cuối cùng vẫn không rõ có đúng không.
Khúc nào khó quá lại phải dựng RPA cho nó chạy rồi xem.

Nhattanktnn · 10/3/23

befaint đã viết:
Khúc nào khó quá lại phải dựng RPA cho nó chạy

Chắc em lại nhờ anh chia sẻ về khúc này nữa quá

Ai nói sao em nghe vậy thôi, vì em nghĩ mọi người ở đây ai cũng giỏi nên không dám lấy trí tuệ của mình ra đánh giá khả năng người khác (Trừ khi quá phi lý

)
Học được cái gì cứ học thôi anh

HeSanbi · 10/3/23

Các bạn không nên học cách viết như ở trên. Thường thì một biến phải có đủ thông tin để não bộ có thể đọc hiểu.
Vì quá trình viết mã với nhiều dòng mã và giải thuật khác nhau. Não bộ có thể không lưu trữ hết hoặc quên nhất thời.

Tuy nhiên không nên đặt biến dài và gọi lại nó, vì rất khó đọc khi giải thuật của bạn cần đọc logic. Ví dụ đặt biến t và có dòng chú thích về biến đó là tốt nhất.

Trên mỗi giải thuật cần gán chú thích. Mã có tham chiếu Lớp hoặc thư viện thì cần chú thích rõ ràng đầy đủ.

Tất cả đều quy về tại não bộ làm sao đơn giản nhất để truy cập lại những gì bạn đã tạo ra trong nó.

befaint · 10/3/23

Nhattanktnn đã viết:
Học được cái gì cứ học thôi anh

Thế mới nói. Khiêm tốn mà có ai chê mình ngốc thì mình vẫn cười được. Làm ngược lại thì thành chuyện hài.

Ngoài UiPath thì có Microsoft Power Automate mới nâng cấp cũng được đấy.
Mới soạn được ít tài liệu hướng dẫn...

Nhattanktnn · 10/3/23

befaint đã viết:
Mới soạn được ít tài liệu hướng dẫn...

Ngày 24h anh có ngồi máy tính tới 23h không mà sao có thời gian soạn được tài liệu này nọ, học python, web, ... tìm hiểu đủ thứ thế nhỉ :wow:

Khi nào soạn xong, nếu có thể, mong anh chia sẻ nhé!

HeSanbi · 10/3/23

Nhattanktnn

Khoe mẻ diễn trò mà bạn đu theo làm gì.

Thà rèn luyện tự lực để có 10 phần đạo đức, 10 phần trí tuệ, còn hơn theo học một thói đời ích kỉ, khoe mẻ, bỏn xẻn.

Có khi đi chôm "google" về nói của mình.

befaint · 10/3/23

Nhattanktnn đã viết:
Ngày 24h anh có ngồi máy tính tới 23h không mà sao có thời gian soạn được tài liệu này nọ, học python, web, ... tìm hiểu đủ thứ thế nhỉ

Thời gian chủ yếu mình đi sửa điện nước, vừa chiều qua tát rửa các bể nước ngầm vẹo cả lưng. Giờ đang nằm chờ cái máy khoan pin sạc xong lại đi sửa điện.
Thời gian còn lại thì chịu khó học chính tả tiếng Việt để không bị ngọng. Chiều qua lúc rửa cái bể nước, mình kêu bác chủ nhà lấy cho cái gáo múc nước. Ổng kêu không có, "lấy tạm cái bát củ này cúng được".
...
Không hiểu ổng nói gì luôn, mình có cần củ gì để cúng đâu, hay tại đang dưới bể nghe nhầm. @@

Nhattanktnn đã viết:
Khi nào soạn xong, nếu có thể, mong anh chia sẻ nhé!

Được luôn.

Nhattanktnn · 10/3/23

befaint đã viết:
Chiều qua lúc rửa cái bể nước, mình kêu bác chủ nhà lấy cho cái gáo múc nước. Ổng kêu không có, "lấy tạm cái bát củ này cúng được".
...
Không hiểu ổng nói gì luôn, mình có cần củ gì để cúng đâu, hay tại đang dưới bể nghe nhầm. @@

Câu chuyện này em không hiểu gì luôn . Em chỉ biết nếu theo đúng kịch bản thì thường là cô chủ nhà

befaint đã viết:
Được luôn.

Anh nhớ nhé! Thôi em không lan man xa đề nữa, để mọi người tiếp tục vấn đề của chủ thớt nhé anh

HeSanbi · 10/3/23

@ptm0412
Tự nhiên bài viết người ta hỏi một đằng, lại có chiếc xe đời 70 vô "khoe mẻ", "lạng lách" rồi biểu diễn "ca múa nhạc", "chèo", "tuồn", "cải lương",... . Nên tôi mời Bác vào xem cho vui. Diễn đàn nay độc lạ, sáng tạo.

befaint · 10/3/23

Một vấn đề có nhiều cách giải.
Người ta hỏi công thức.
Bí quá thì dí... VBA
Và gợi ý dùng RPA cũng là một phương án hoàn toàn hợp lý.

bebo021999 · 10/3/23

Nếu theo yêu cầu bằng lời từ chủ thớt, nghĩa là xếp theo thứ tự giảm dần, khi đạt mức <=6000 thì lấy
thì code sau cũng ra kết quả như HeSanbi

PHP:

Option Explicit
Sub sapxep()
Dim i&, j&, k&, max&, data, res(), tmp, sum As Double, remain As Double
Dim dic As Object, key
Set dic = CreateObject("Scripting.Dictionary")
data = Range("B4:E10").Value
ReDim res(1 To UBound(data) * UBound(data, 2), 1 To 1)
For i = 1 To UBound(data)
    For j = 1 To UBound(data, 2)
        k = k + 1: res(k, 1) = data(i, j)
    Next
Next
For i = 1 To UBound(res) - 1
    For j = i + 1 To UBound(res)
        If res(i, 1) < res(j, 1) Then tmp = res(j, 1): res(j, 1) = res(i, 1): res(i, 1) = tmp
    Next
Next
For i = 1 To UBound(res)
    dic.Add i, res(i, 1)
Next
ReDim res(1 To 100, 1 To 100)
For j = 1 To 10
    remain = 6000: i = 0
    For Each key In dic.keys
        remain = remain - dic(key)
        If remain > 0 Then
            i = i + 1: res(i, j) = dic(key): dic.Remove (key)
        Else: remain = remain + dic(key)
        End If
    Next
    If i > max Then max = i
Next
[b14].Resize(max, j).Value = res
End Sub

Tuy nhiên nhìn kỹ thì dường như không phải vậy.
Cột thứ 3, số 900 thay bằng 780+780 = 1560 để đạt mức dư là ít nhất.
Vậy rốt cuộc bài toán trở thành tìm các đoạn cây kết hợp cho ra số thừa là ít nhất?

befaint · 10/3/23

May mà mình vẫn nhớ từ khóa, dùng RPA tìm ra link luôn.

Bạn thớt lấy bài giải ở đây nhé.

Tiện ích tính toán để tiết kiệm khi cắt tấm, cắt thanh.

Lần trước tôi đã gửi một file dùng để tính toán các sắp xếp tối ưu những hình chữ nhật nhỏ có cùng kích thước trong một hình chữ nhật lớn để số lượng hình chữ nhật nhỏ được xếp là lớn nhất. Tiện ích này sẽ giúp các bạn tiết kiệm không gian khi sắp xếp hàng hóa, tiết kiệm nguyên liệu khi cắt một...

www.giaiphapexcel.com

HeSanbi · 10/3/23

bebo021999 đã viết:
Nếu theo yêu cầu bằng lời từ chủ thớt, nghĩa là xếp theo thứ tự giảm dần, khi đạt mức <=6000 thì lấy
thì code sau cũng ra kết quả như HeSanbi

PHP:

Option Explicit Sub sapxep() Dim i&, j&, k&, max&, data, res(), tmp, sum As Double, remain As Double Dim dic As Object, key Set dic = CreateObject("Scripting.Dictionary") data = Range("B4:E10").Value ReDim res(1 To UBound(data) * UBound(data, 2), 1 To 1) For i = 1 To UBound(data) For j = 1 To UBound(data, 2) k = k + 1: res(k, 1) = data(i, j) Next Next For i = 1 To UBound(res) - 1 For j = i + 1 To UBound(res) If res(i, 1) < res(j, 1) Then tmp = res(j, 1): res(j, 1) = res(i, 1): res(i, 1) = tmp Next Next For i = 1 To UBound(res) dic.Add i, res(i, 1) Next ReDim res(1 To 100, 1 To 100) For j = 1 To 10 remain = 6000: i = 0 For Each key In dic.keys remain = remain - dic(key) If remain > 0 Then i = i + 1: res(i, j) = dic(key): dic.Remove (key) Else: remain = remain + dic(key) End If Next If i > max Then max = i Next [b14].Resize(max, j).Value = res End Sub

Tuy nhiên nhìn kỹ thì dường như không phải vậy.
Cột thứ 3, số 900 thay bằng 780+780 = 1560 để đạt mức dư là ít nhất.
Vậy rốt cuộc bài toán trở thành tìm các đoạn cây kết hợp cho ra số thừa là ít nhất?

Có lẽ nên thử trường hợp Bác nói.
Tìm tổng lớn nhất nhỏ hơn bằng đoạn thừa cần bù.

huuthang_bd · 10/3/23

Đầu tiên mình thử với dữ liệu đơn giản như thế này thử nhé.

cần giúp cách sắp xếp các đoạn có kích thước khác nhau thành 1 cây dài 6m

Thành viên mới

File đính kèm

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên gắn bó

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

!!! Giải thoát !!!

Thành viên gắn bó

|||||||||||||

Thành viên gắn bó

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

|||||||||||||

Thành viên gắn bó

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Nhattanktnn​

|||||||||||||

Thành viên gắn bó

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

|||||||||||||

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

|||||||||||||

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Chuyên gia GPE

Đếm ngược thời gian

Nhattanktnn