lập công thức chia số lượng tự động theo yêu cầu (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
powerofloveinmyheart đã viết:
nhờ các cao thủ làm giúp em bảng chia tự động thay vì phải đi chia bằng tay
Nhấp chuột vào đây để mở rộng...

Không hiểu bạn chia cái gì vậy, mới 3 tết đã chia vậy, bài này bạn đang làm cho cái gì thế?,

Nếu là tính tổng thì bạn dùng hàm SUM là được, còn chia bạn cứ liệt kê như chia tay đó là xong?
 
Lần chỉnh sửa cuối:
powerofloveinmyheart đã viết:
nhờ các cao thủ làm giúp em bảng chia tự động thay vì phải đi chia bằng tay
Nhấp chuột vào đây để mở rộng...

bạn thử code này
lâu quá không viết vba nên giải thuật bị lũng cũn
Mã: 
Sub ChiaBo()
Dim SArr, RArr, i, j, k, T, R As Long
SArr = [A5].Resize([c10000].End(3).Row, 3).Value
ReDim RArr(1 To 2 * UBound(SArr), 1 To 3)

For i = 1 To UBound(SArr) - 4
  T = T + SArr(i, 2)
    If T <= 30 Then
        k = k + 1
        For j = 1 To 3
            RArr(k, j) = SArr(i, j)
        Next
        t1 = t1 + RArr(k, 2)
    Else
    Do Until T <= 30
   R = T - 30
   k = k + 1
        RArr(k, 1) = SArr(i, 1)
        If t1 > 30 Then RArr(k, 2) = 30 Else RArr(k, 2) = 30 - t1
        RArr(k, 3) = SArr(i, 3)
        t1 = t1 + RArr(k, 2)
        k = k + 1
        
        If t1 > 30 Then
            k = k + 1
            RArr(k, 1) = SArr(i, 1)
            RArr(k, 2) = R
            RArr(k, 3) = SArr(i, 3)
            t1 = t1 + RArr(k, 2)
        End If
        T = R
        t1 = R
   
    Loop
    End If
   
    
Next
[k5].Resize(1000, 3).Clear
[k5].Resize(k, 3) = RArr

End Sub
 
Let'GâuGâu đã viết:
bạn thử code này
lâu quá không viết vba nên giải thuật bị lũng cũn
Mã: 
Sub ChiaBo()
Dim SArr, RArr, i, j, k, T, R As Long
SArr = [A5].Resize([c10000].End(3).Row, 3).Value
ReDim RArr(1 To 2 * UBound(SArr), 1 To 3)

For i = 1 To UBound(SArr) - 4
  T = T + SArr(i, 2)
    If T <= 30 Then
        k = k + 1
        For j = 1 To 3
            RArr(k, j) = SArr(i, j)
        Next
        t1 = t1 + RArr(k, 2)
    Else
    Do Until T <= 30
   R = T - 30
   k = k + 1
        RArr(k, 1) = SArr(i, 1)
        If t1 > 30 Then RArr(k, 2) = 30 Else RArr(k, 2) = 30 - t1
        RArr(k, 3) = SArr(i, 3)
        t1 = t1 + RArr(k, 2)
        k = k + 1
        
        If t1 > 30 Then
            k = k + 1
            RArr(k, 1) = SArr(i, 1)
            RArr(k, 2) = R
            RArr(k, 3) = SArr(i, 3)
            t1 = t1 + RArr(k, 2)
        End If
        T = R
        t1 = R
   
    Loop
    End If
   
    
Next
[k5].Resize(1000, 3).Clear
[k5].Resize(k, 3) = RArr

End Sub
Nhấp chuột vào đây để mở rộng...

Nếu có dòng Option Explicit thì thiếu khai báo t1
Tổng cột L là 91, thiếu 19 (Đúng phải là 110)
Chắc chưa ổn.
 
em đang cần chia thành các bó hàng có số lượng bằng nhau, thank các bác đã chỉ giáo, có gì khúc mắc cho em mạn phép được hỏi tiếp
tamtam333 đã viết:
Không hiểu bạn chia cái gì vậy, mới 3 tết đã chia vậy, bài này bạn đang làm cho cái gì thế?,

Nếu là tính tổng thì bạn dùng hàm SUM là được, còn chia bạn cứ liệt kê như chia tay đó là xong?
Nhấp chuột vào đây để mở rộng...
 
Ba Tê đã viết:
Cái này cũng vui à nghe.
Làm thí thí bằng VBA xem sao, chưa ngắn gọn lắm vì còn "lầng quầng"
Nhấp chuột vào đây để mở rộng...
đúng cái em cần bác ạ
nhưng em khai báo số lượng cao tầm khoảng 600 cái thì lỗi "Runtime error 9", máy tính em Dual-Core 2.7Gz Ram 3G, bác xem giúp em không giới hạn số lượng
thêm vấn đề nữa là em thêm cột "trọng lượng" thì bên tự động cột "đánh dấu" lỗi N/A
 

File đính kèm

powerofloveinmyheart đã viết:
đúng cái em cần bác ạ
nhưng em khai báo số lượng cao tầm khoảng 600 cái thì lỗi "Runtime error 9", máy tính em Dual-Core 2.7Gz Ram 3G, bác xem giúp em không giới hạn số lượng
thêm vấn đề nữa là em thêm cột "trọng lượng" thì bên tự động cột "đánh dấu" lỗi N/A
Nhấp chuột vào đây để mở rộng...

Bạn không tự chỉnh code được thì từ đầu đưa dữ liệu như thật đi, đâu phải muốn chèn thêm cột là chèn.
Không giới hạn số lượng là sao? Bảng tính chỉ có 1.048.576 dòng thôi, phải có giới hạn trong số đó chứ.
Thử lại SUB này xem:
PHP: 
Public Sub GPE()
Dim sArr(), dArr(1 To 1048576, 1 To 5), I As Long, K As Long, LuBu As Long, Tem As Long
sArr = Range([A5], [D1048576].End(xlUp)).Value2
For I = 1 To UBound(sArr, 1)
    If sArr(I, 2) <> Empty Then
        K = K + 1
        dArr(K, 2) = sArr(I, 1)
        dArr(K, 4) = sArr(I, 3)
        dArr(K, 5) = sArr(I, 4)
        If LuBu + sArr(I, 2) <= 30 Then
            LuBu = LuBu + sArr(I, 2)
            dArr(K, 3) = sArr(I, 2)
            If LuBu = 30 Then
                LuBu = 0
                K = K + 1
                dArr(K, 1) = "1 Bo 30"
            End If
        Else
            Tem = 30 - LuBu
            dArr(K, 3) = Tem
            sArr(I, 2) = sArr(I, 2) - Tem
            LuBu = 0
            I = I - 1
            K = K + 1
            dArr(K, 1) = "1 Bo 30"
        End If
    End If
Next I
[G5:K1048576].ClearContents
[G5:K5].Resize(K) = dArr
End Sub
 
Ba Tê đã viết:
Bạn không tự chỉnh code được thì từ đầu đưa dữ liệu như thật đi, đâu phải muốn chèn thêm cột là chèn.
Không giới hạn số lượng là sao? Bảng tính chỉ có 1.048.576 dòng thôi, phải có giới hạn trong số đó chứ.
Thử lại SUB này xem:
PHP: 
Public Sub GPE()
Dim sArr(), dArr(1 To 1048576, 1 To 5), I As Long, K As Long, LuBu As Long, Tem As Long
sArr = Range([A5], [D1048576].End(xlUp)).Value2
For I = 1 To UBound(sArr, 1)
    If sArr(I, 2) <> Empty Then
        K = K + 1
        dArr(K, 2) = sArr(I, 1)
        dArr(K, 4) = sArr(I, 3)
        dArr(K, 5) = sArr(I, 4)
        If LuBu + sArr(I, 2) <= 30 Then
            LuBu = LuBu + sArr(I, 2)
            dArr(K, 3) = sArr(I, 2)
            If LuBu = 30 Then
                LuBu = 0
                K = K + 1
                dArr(K, 1) = "1 Bo 30"
            End If
        Else
            Tem = 30 - LuBu
            dArr(K, 3) = Tem
            sArr(I, 2) = sArr(I, 2) - Tem
            LuBu = 0
            I = I - 1
            K = K + 1
            dArr(K, 1) = "1 Bo 30"
        End If
    End If
Next I
[G5:K1048576].ClearContents
[G5:K5].Resize(K) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...
thank bác rất nhiều, kết quả rất chuẩn không hề có lỗi gì, nhờ bác chỉ giáo em thêm cái mục chia theo ý muốn này, nghĩa là muốn chia ra thành các bó có số lượng khác nhau ( số lượng muốn chia đã nhập sẵn có thể thay đổi được)
 

File đính kèm

powerofloveinmyheart đã viết:
thank bác rất nhiều, kết quả rất chuẩn không hề có lỗi gì, nhờ bác chỉ giáo em thêm cái mục chia theo ý muốn này, nghĩa là muốn chia ra thành các bó có số lượng khác nhau ( số lượng muốn chia đã nhập sẵn có thể thay đổi được)
Nhấp chuột vào đây để mở rộng...

Bạn nên phải thống nhất từ đầu, xem lại thấy bạn cứ thay đổi cách bố trí dữ liệu thì sẽ khó cho người lập trình

Code sau phù hợp cho bài trên, với "số lượng cần chia" đặt tại cột E từ E5,E6,... (số liệu này phải liên tục , không chưa khoảng trắng)

vì bạn biết VBA rồi, nên bạn tự đặt code vào module1 và tự chạy sub sau nhé

Mã: 
Sub CHIACHIA()
    Const NumberOfSpaceLines = 1
    
    Dim sAr As Variant, aDi As Variant, rAr As Variant
    Dim i As Long, n As Long, m As Long, k As Long
    Dim Sum As Double, tMp As Double
    Dim ceL As Range
    Dim bo As Boolean
    
    Set ceL = Sheet1.[A5]
    n = Sheet1.Rows.Count - ceL.Row
    sAr = Range(ceL, ceL.Offset(n).End(xlUp)).Resize(, 4).Value2
    aDi = Range(ceL.Offset(, 4), ceL.Offset(n, 4).End(xlUp)).Value2
    ReDim rAr(1 To n, 1 To 5)
    m = UBound(aDi)
    
    Sum = 0
    n = 0
    k = 1
    For i = 1 To UBound(sAr)
       tMp = sAr(i, 2)
       Do While tMp > 0
            n = n + 1
            rAr(n, 1) = sAr(i, 1)
            rAr(n, 3) = sAr(i, 3)
            rAr(n, 4) = sAr(i, 4)
            
            bo = k <= m
            If bo Then bo = Sum + tMp >= aDi(k, 1)
            If bo Then
                rAr(n, 2) = aDi(k, 1) - Sum
                rAr(n, 5) = aDi(k, 1)
                Sum = 0
                tMp = tMp - rAr(n, 2)
                n = n + NumberOfSpaceLines
                k = k + 1
            Else
                rAr(n, 2) = tMp
                Sum = Sum + tMp
                tMp = 0
            End If
       Loop
    Next i
    If Sum > 0 Then rAr(n, 5) = Sum
    
    With ceL.Offset(, 6)
        .Resize(65000, 5).ClearContents
        .Resize(n, 5) = rAr
    End With
End Sub
 
giola đã viết:
Bạn nên phải thống nhất từ đầu, xem lại thấy bạn cứ thay đổi cách bố trí dữ liệu thì sẽ khó cho người lập trình

Code sau phù hợp cho bài trên, với "số lượng cần chia" đặt tại cột E từ E5,E6,... (số liệu này phải liên tục , không chưa khoảng trắng)

vì bạn biết VBA rồi, nên bạn tự đặt code vào module1 và tự chạy sub sau nhé

Mã: 
Sub CHIACHIA()
    Const NumberOfSpaceLines = 1
    
    Dim sAr As Variant, aDi As Variant, rAr As Variant
    Dim i As Long, n As Long, m As Long, k As Long
    Dim Sum As Double, tMp As Double
    Dim ceL As Range
    Dim bo As Boolean
    
    Set ceL = Sheet1.[A5]
    n = Sheet1.Rows.Count - ceL.Row
    sAr = Range(ceL, ceL.Offset(n).End(xlUp)).Resize(, 4).Value2
    aDi = Range(ceL.Offset(, 4), ceL.Offset(n, 4).End(xlUp)).Value2
    ReDim rAr(1 To n, 1 To 5)
    m = UBound(aDi)
    
    Sum = 0
    n = 0
    k = 1
    For i = 1 To UBound(sAr)
       tMp = sAr(i, 2)
       Do While tMp > 0
            n = n + 1
            rAr(n, 1) = sAr(i, 1)
            rAr(n, 3) = sAr(i, 3)
            rAr(n, 4) = sAr(i, 4)
            
            bo = k <= m
            If bo Then bo = Sum + tMp >= aDi(k, 1)
            If bo Then
                rAr(n, 2) = aDi(k, 1) - Sum
                rAr(n, 5) = aDi(k, 1)
                Sum = 0
                tMp = tMp - rAr(n, 2)
                n = n + NumberOfSpaceLines
                k = k + 1
            Else
                rAr(n, 2) = tMp
                Sum = Sum + tMp
                tMp = 0
            End If
       Loop
    Next i
    If Sum > 0 Then rAr(n, 5) = Sum
    
    With ceL.Offset(, 6)
        .Resize(65000, 5).ClearContents
        .Resize(n, 5) = rAr
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
tuyệt vời ông mặt trời....thank bác rất nhiều. em mới tập tọe thôi mong bác thông cảm. xin rút kinh nghiệm lần sau
 
bác có thể giúp em cột E5 trở xuống có thể chứa số liệu không liên tục, có khoảng trống được không ạ. tại vì khi chia cứ phải xuống để kiểm tra xem dữ liệu đã chia đến đâu rồi lại kéo lên nhập vào cột E để chia tiếp ( với dữ liệu nhiều rất bất tiện)
nếu cột E có thể chứa dữ liệu không liên tục, có khoảng trống thì chỉ việc nhập số cần chia tiếp theo vào cột E tương ứng với vị trí đã ra kết quả của lần chia trước, được vậy thì rất là thuận tiện, bác xem dùm em
 

File đính kèm

powerofloveinmyheart đã viết:
bác có thể giúp em cột E5 trở xuống có thể chứa số liệu không liên tục, có khoảng trống được không ạ. tại vì khi chia cứ phải xuống để kiểm tra xem dữ liệu đã chia đến đâu rồi lại kéo lên nhập vào cột E để chia tiếp ( với dữ liệu nhiều rất bất tiện)
nếu cột E có thể chứa dữ liệu không liên tục, có khoảng trống thì chỉ việc nhập số cần chia tiếp theo vào cột E tương ứng với vị trí đã ra kết quả của lần chia trước, được vậy thì rất là thuận tiện, bác xem dùm em
Nhấp chuột vào đây để mở rộng...

Lại một lần nữa, bạn không chuẩn bị số liệu, yêu cầu trước trọn vẹn. Cứ để người giúp chạy theo thế, chạy theo .... gặp sếp kiểu này có khi nhân viên nó bỏ việc

Sử dụng code này đi, chú ý vị trí cột "số lượng chia" vẫn bắt đầu từ E5

Mã: 
Sub CHIACHIA()
    Const NumberOfSpaceLines = 1
    
    Dim sAr As Variant, aDi As Variant, rAr As Variant
    Dim i As Long, n As Long, m As Long, k As Long, nR As Long
    Dim Sum As Double, tMp As Double
    Dim ceL As Range
    Dim bo As Boolean
    
    Set ceL = Sheet1.[A5]
    nR = Sheet1.Rows.Count - ceL.Row
    sAr = Range(ceL, ceL.Offset(nR).End(xlUp)).Resize(, 4).Value2
    aDi = Range(ceL.Offset(, 4), ceL.Offset(nR, 4).End(xlUp)).Value2
    ReDim rAr(1 To nR, 1 To 5)
    n = UBound(aDi)
    
    m = 0
    For i = 1 To n
        If aDi(i, 1) > 0 Then
            m = m + 1
            aDi(m, 1) = aDi(i, 1)
        End If
    Next
    
    k = 1
    Sum = 0
    n = 0
    For i = 1 To UBound(sAr)
       tMp = sAr(i, 2)
       Do While tMp > 0
            n = n + 1
            rAr(n, 1) = sAr(i, 1)
            rAr(n, 3) = sAr(i, 3)
            rAr(n, 4) = sAr(i, 4)
            
            bo = k <= m
            If bo Then bo = Sum + tMp >= aDi(k, 1)
            If bo Then
                rAr(n, 2) = aDi(k, 1) - Sum
                rAr(n, 5) = aDi(k, 1)
                Sum = 0
                tMp = tMp - rAr(n, 2)
                n = n + NumberOfSpaceLines
                k = k + 1
            Else
                rAr(n, 2) = tMp
                Sum = Sum + tMp
                tMp = 0
            End If
       Loop
    Next i
    If Sum > 0 Then rAr(n, 5) = Sum
    
    With ceL.Offset(, 6)
        .Resize(nR, 5).ClearContents
        .Resize(n, 5) = rAr
    End With
End Sub
 
Lần chỉnh sửa cuối:
Nhờ các bác chỉ giùm cách chia các mặt hàng trong danh sách thành 05 lần để đóng gói thành từng đơn với giá trị hàng hóa mỗi lần đóng gói gần tương đương nhau.
 

File đính kèm

File đính kèm

anhvuhvnh đã viết:
Nhờ các bác chỉ giùm cách chia các mặt hàng trong danh sách thành 05 lần để đóng gói thành từng đơn với giá trị hàng hóa mỗi lần đóng gói gần tương đương nhau.
Nhấp chuột vào đây để mở rộng...
Trừ sản phẩm thứ 1, còn lại số lượng đều là bội số của 5. Bạn cứ chia đều số lượng cho 5 gói riêng sản phẩm thứ nhất thì chia 2 2 2 2 1 là được thôi.
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

T
In lặp lại nhiều dòng ở cuối các trang (2 người xem)
Trả lời
6
Đọc
280
THUONG@
T
T
Lỗi Khi Mở File Excel (1 người xem)
Trả lời
3
Đọc
40
Hoàng Tuấn 868
H
GPE-Trợ Lý
ĐĂNG KÍ THAM DỰ SINH NHẬT GPE TẠI HN - SỰ KIỆN TALKSHOW ĐẶC BIỆT
    • Thích
2
Trả lời
23
Đọc
1K
PhanTuHuong
PhanTuHuong
H
Em chào anh chị ạ.Em cần xếp lịch nghỉ randum cho 1 số nhóm làm việc trong 1 công ty. (2 người xem)
Trả lời
4
Đọc
93
Duy Tùng 9x
Duy Tùng 9x
K
Tạo mã thiết bị (1 người xem)
Trả lời
9
Đọc
171
Duy Tùng 9x
Duy Tùng 9x
1
Em hỏi chút về hàm điều kiện với liệt kê
Trả lời
2
Đọc
112
123456it
1
M
File excel ứng dụng trong nhập xuất kho, thu chi, bán hàng và công nợ (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
7 8 9
Trả lời
165
Đọc
31K
quick87
quick87
chickenexcel
xin hướng dẫn code chọn hình ảnh trong file
Trả lời
2
Đọc
72
chickenexcel
chickenexcel
tramcannt
data validation (1 người xem)
Trả lời
2
Đọc
84
ptm0412
ptm0412
giaiphap
Add-Ins cho Excel 2007 -2016 32bit và 64bit
    • Thích
    • Yêu thích
    • Ngạc nhiên
24 25 26
Trả lời
514
Đọc
204K
hoangtuan.net
hoangtuan.net
Nguyễn Duy Tuân
  • Dán lên cao
Phiên bản mới Add-in A-Tools AI v10 (2024)
    • Thích
2 3
Trả lời
56
Đọc
7K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Nguyễn Duy Tuân
  • Dán lên cao
Sử dụng AI trong Excel với Add-in A-Tools AI v10
    • Thích
    • Cảm ơn
Trả lời
6
Đọc
792
Nguyễn Duy Tuân
Nguyễn Duy Tuân
H
Lỗi syntax error
Trả lời
2
Đọc
101
ptm0412
ptm0412
H
Xin các bác giúp đỡ cách đổi thời gian thành số thập phân
Trả lời
8
Đọc
148
huyphanthieu
H
T
Cách cộng tổng chính xác nhất
Trả lời
4
Đọc
109
ngocbaovu
ngocbaovu
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
17 18 19
Trả lời
361
Đọc
40K
NGUYEN THOA 123
NGUYEN THOA 123
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
14
Đọc
1K
tungnguyen_kt
tungnguyen_kt
Maithy46
Giúp mình về việc lập bảng theo dõi chi tiết, báo cáo sản lượng công đoạn trong ngành may mặc ạ
Trả lời
4
Đọc
519
Maithy46
Maithy46
MrAnt
Dùng excel add-in lấy báo cáo từ SQL
Trả lời
5
Đọc
500
Nhattanktnn
Nhattanktnn
Bùi Thúy Thúy
Tắt thông báo "Sign in" khi mở file excel
Trả lời
1
Đọc
112
vanle33
vanle33
Xem thêm…

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

Sinh nhật lần 19 GPE

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom