Mọi người giúp mình tách tên hàng theo từng số lượng

hunglam123 · 18/4/20

Chào các anh chị diễn đàn PGE . Em cần tách 1 vùng như hình đính kèm bên dưới. nhờ mọi người. xin chân thành cảm ơn

VetMini · 18/4/20

Code này có cả đống rồi. Chịu khó mà tìm.

SA_DQ · 18/4/20

Mình 'tìm' giúp cho bạn nè, mại zô.

PHP:

Sub TaoBangVoiSoLuongBang1()
Dim J As Long, W As Integer, SoLg As Long, Dem As Integer, Dg As Integer
Dim Arr(), WF As Object

Arr() = [C3].CurrentRegion.Offset(2).Value
Set WF = Application.WorksheetFunction
SoLg = WF.Sum([C3].Resize(UBound(Arr())))
ReDim dArr(1 To SoLg, 1 To 4):       [G3].Resize(9 + SoLg, 4).Value = ""
For J = 1 To UBound(Arr())
    If Arr(J, 2) = "" Then Exit For
    For Dg = 1 To Arr(J, 2)
        W = W + 1
        dArr(W, 1) = Arr(J, 1):             dArr(W, 2) = 1
        dArr(W, 3) = Arr(J, 3):             dArr(W, 4) = Arr(J, 4)
    Next Dg
Next J
[G3].Resize(W, 4).Value = dArr():      Randomize
[g2:j2].Interior.ColorIndex = 34 + 9 * Rnd() \ 1
End Sub

concogia · 18/4/20

SA_DQ đã viết:

Mình 'tìm' giúp cho bạn nè, mại zô.

PHP:

Sub TaoBangVoiSoLuongBang1()
Dim J As Long, W As Integer, SoLg As Long, Dem As Integer, Dg As Integer
Dim Arr(), WF As Object

Arr() = [C3].CurrentRegion.Offset(2).Value
Set WF = Application.WorksheetFunction
SoLg = WF.Sum([C3].Resize(UBound(Arr())))
ReDim dArr(1 To SoLg, 1 To 4):       [G3].Resize(9 + SoLg, 4).Value = ""
For J = 1 To UBound(Arr())
    If Arr(J, 2) = "" Then Exit For
    For Dg = 1 To Arr(J, 2)
        W = W + 1
        dArr(W, 1) = Arr(J, 1):             dArr(W, 2) = 1
        dArr(W, 3) = Arr(J, 3):             dArr(W, 4) = Arr(J, 4)
    Next Dg
Next J
[G3].Resize(W, 4).Value = dArr():      Randomize
[g2:j2].Interior.ColorIndex = 34 + 9 * Rnd() \ 1
End Sub

Tui muốn....1 vòng lặp "thui". Được hông ?????

hunglam123 · 18/4/20

SA_DQ đã viết:

Mình 'tìm' giúp cho bạn nè, mại zô.

PHP:

Sub TaoBangVoiSoLuongBang1()
Dim J As Long, W As Integer, SoLg As Long, Dem As Integer, Dg As Integer
Dim Arr(), WF As Object

Arr() = [C3].CurrentRegion.Offset(2).Value
Set WF = Application.WorksheetFunction
SoLg = WF.Sum([C3].Resize(UBound(Arr())))
ReDim dArr(1 To SoLg, 1 To 4):       [G3].Resize(9 + SoLg, 4).Value = ""
For J = 1 To UBound(Arr())
    If Arr(J, 2) = "" Then Exit For
    For Dg = 1 To Arr(J, 2)
        W = W + 1
        dArr(W, 1) = Arr(J, 1):             dArr(W, 2) = 1
        dArr(W, 3) = Arr(J, 3):             dArr(W, 4) = Arr(J, 4)
    Next Dg
Next J
[G3].Resize(W, 4).Value = dArr():      Randomize
[g2:j2].Interior.ColorIndex = 34 + 9 * Rnd() \ 1
End Sub

dạ cảm ơn anh nhiều !

VetMini · 18/4/20

concogia đã viết:
Tui muốn....1 vòng lặp "thui". Được hông ?????

Chi vậy? 1 vòng lặp có giảm được số con tính hôn?
Bài này đáng lẽ phải thấy 3 vòng lặp. Người ta đã tự giảm hết 1 rồi.

concogia · 18/4/20

VetMini đã viết:
Chi vậy? 1 vòng lặp có giảm được số con tính hôn?
Bài này đáng lẽ phải thấy 3 vòng lặp. Người ta đã tự giảm hết 1 rồi.

Bài này chính xác là 2 vòng lặp, còn 1 vòng là vui chơi thôi chứ có chi đâu, cò 3 vòng thì ....không biết

VetMini · 18/4/20

Chép theo bên mảng kết quả thì là 1 vòng lặp.

soCanChep = 0
i2 = 0 ' đếm mảng source
For i = 1 To dongCuoi ' chép mảng kết quả
If i >= soCanChep Then
soChep = 0
i2 = i2 + 1
soCanChep = soCanChep + a(i2, 2)
End If
b(i, 1) = a(i2, 1)
b(i, 2) = 1
b(i, 3 = a(i2, 3)
b(i, 4) = a(i2, 4)
Next i

hunglam123 · 18/4/20

VetMini đã viết:
Chép theo bên mảng kết quả thì là 1 vòng lặp.

soCanChep = 0
i2 = 0 ' đếm mảng source
For i = 1 To dongCuoi ' chép mảng kết quả
If i >= soCanChep Then
soChep = 0
i2 = i2 + 1
soCanChep = soCanChep + a(i2, 2)
End If
b(i, 1) = a(i2, 1)
b(i, 2) = 1
b(i, 3 = a(i2, 3)
b(i, 4) = a(i2, 4)
Next i

bạn giúp cho người ta thì giúp cho đàng hoàng, viết code cho rõ ràng đầy đủ lại được không. chứ mình thử thì không đúng cú pháp

VetMini · 18/4/20

hunglam123 đã viết:
bạn giúp cho người ta thì giúp cho đàng hoàng, viết code cho rõ ràng đầy đủ lại được không. chứ mình thử thì không đúng cú pháp
...

Chi vậy? Code chỉ dùng để diễn tả thuật toán theo câu hỏi bài #4. Đâu có giúp ai đâu.

concogia · 18/4/20

Ủa, mình nhớ bài #4 hình như mình có trích dẫn bài viết của bác SA_DêQuáXá mà ta

Hoàng Nhật Phương · 18/4/20

hunglam123 đã viết:
Chào các anh chị diễn đàn PGE . Em cần tách 1 vùng như hình đính kèm bên dưới. nhờ mọi người. xin chân thành cảm ơn
View attachment 235905

Có khi nào "DATA BAN ĐẦU" Tên hàng có nhiều mặt hàng giống nhau không bạn, ví dụ bánh chưng lần1=1 lần 2=3 => Tổng 2 lần = 4
Như vậy "DATA MONG MUỐN" phải 4 dòng?

PacificPR · 18/4/20

Có người mua nửa cái bánh chưng thì tách làm sao

CHAOQUAY · 18/4/20

PacificPR đã viết:
Có người mua nửa cái bánh chưng thì tách làm sao

Có lẽ họ sẽ gọi bạn tới mua nửa còn lại

PacificPR · 18/4/20

CHAOQUAY đã viết:
Có lẽ họ sẽ gọi bạn tới mua nửa còn lại

Em mà mua chỉ mua 1/4 cái thôi. Nửa cái ăn không hết

Hoàng Nhật Phương · 18/4/20

Nguyễn Hoàng Oanh Thơ đã viết:
Có khi nào "DATA BAN ĐẦU" Tên hàng có nhiều mặt hàng giống nhau không bạn, ví dụ bánh chưng lần1=1 lần 2=3 => Tổng 2 lần = 4
Như vậy "DATA MONG MUỐN" phải 4 dòng?

OT đang học Dictionary nên hỏi trường hợp này và cũng code thử xem thế nào, thấy code cũng chạy được và cũng cho ra kết quả:

Mã:

Sub Tac_Dong()

    Dim Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
  
    Dim Vao As Variant, Ra As Variant, sh As Worksheet
    Dim Key As String, iKey As Integer
    Dim I As Long, R As Long, K As Long, J As Long
  
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    R = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row
    If R < 3 Then Exit Sub
    Vao = sh.Range("B3:E" & R).Value
    R = WorksheetFunction.Sum(sh.Range("C3:C" & R))
    ReDim Ra(1 To R, 1 To 4)
  
    For I = 1 To UBound(Vao)
        Key = Vao(I, 1): iKey = Vao(I, 2)
        If Key <> Empty Then
            If Not Dic.Exists(Key) Then
                Dic.Add Key, iKey
            Else
                Dic(Key) = Dic.Item(Key) + iKey
            End If
            For J = 1 To iKey
                K = K + 1
                Ra(K, 1) = Key
                Ra(K, 2) = iKey / iKey
                Ra(K, 3) = Vao(I, 3)
                Ra(K, 4) = Vao(I, 4)
            Next J
        End If
    Next I
  
    sh.Range("G3").Resize(10000, 4).ClearContents
    sh.Range("G3").Resize(R, 4).Value = Ra
  
End Sub

SA_DQ · 18/4/20

Có khi nào "DATA BAN ĐẦU" Tên hàng có nhiều mặt hàng giống nhau không bạn, ví dụ bánh chưng lần1=1 lần 2=3 => Tổng 2 lần = 4
Như vậy "DATA MONG MUỐN" phải 4 dòng?

Thì cũng có tất thẩy 4 dòng thôi, tuy không nằm gần nhau giữa các dòng cùng mã hàng; Nhưng đó là đang zản cách XH nhằm chống Covid19 mà!

Bài đã được tự động gộp: 18/4/20

Nguyễn Hoàng Oanh Thơ đã viết:
OT đang học Dictionary nên hỏi trường hợp này và cũng code thử xem thế nào, thấy code cũng chạy được và cũng cho ra kết quả:

Tuyệt vời! Nhưng nếu khong xài Dict thì có làm thế này không vậy:

DATA BAN ĐẦU					DATA MONG MUỐN
Tên hàng	SL	Đơn giá	Ghi chú		Tên hàng	SL	Đơn giá	Ghi chú
*Bánh ít*	3	2000	Ít gai		Bánh ít	1	2000	Ít gai
Bánh chưng	1	5000			Bánh ít	1	2000	Ít gai
Bánh tét	4	6000	Ít nhân		Bánh ít	1	2000	Ít gai
Thịt chó	1	7000			Bánh ít	1	2000	Ít gai
Bánh ít	2	2000	Ít gai	\|==>	Bánh ít	1	2000	Ít gai
					Bánh chưng	1	5000
					Bánh tét	1	6000	Ít nhân
					Bánh tét	1	6000	Ít nhân
					Bánh tét	1	6000	Ít nhân
					Bánh tét	1	6000	Ít nhân
					Thịt chó	1	7000

PHP:

Sub DonDongVoiHon1MatHang()
 Dim Rng As Range, sRng As Range, WF As Object, Cls As Range
 Dim MyAdd As String, TenHH As String
 Dim J As Long, W As Integer, SoLg As Long, Dm As Integer, Dg As Integer, Rws As Long
 
 Rws = [B2].CurrentRegion.Rows.Count:           Set WF = Application.WorksheetFunction
 SoLg = WF.Sum([C3].Resize(Rws)):                   TenHH = "GPE.COM"
 ReDim Arr(1 To SoLg, 1 To 4):                      [G3].Resize(9 + SoLg, 4).Value = ""
 Set Rng = [B2].Resize(Rws)
 For Each Cls In Range([B3], [B3].End(xlDown))
    If InStr(TenHH, Cls.Value) < 1 Then
        TenHH = Cls.Value & TenHH
         Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
        If Not sRng Is Nothing Then
            MyAdd = sRng.Address
            Do
                For Dg = 1 To sRng.Offset(, 1).Value
                    W = W + 1:                                  Arr(W, 1) = Cls.Value
                    Arr(W, 2) = 1:                              Arr(W, 3) = sRng.Offset(, 2).Value
                    Arr(W, 4) = sRng.Offset(, 3).Value
                Next Dg
                Set sRng = Rng.FindNext(sRng)
            Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        End If
    End If
 Next Cls
 [G3].Resize(W, 4).Value = Arr()
End Sub

Hoàng Nhật Phương · 18/4/20

SA_DQ đã viết:
Thì cũng có tất thẩy 4 dòng thôi, tuy không nằm gần nhau giữa các dòng cùng mã hàng; Nhưng đó là đang zản cách XH nhằm chống Covid19 mà!

Bài đã được tự động gộp: 18/4/20

Tuyệt vời! Nhưng nếu khong xài Dict thì có làm thế này không vậy:

DATA BAN ĐẦU DATA MONG MUỐN
Tên hàng SL Đơn giá Ghi chú Tên hàng SL Đơn giá Ghi chú
Bánh ít
3
2000
Ít gai Bánh ít
1
2000
Ít gai
Bánh chưng
1
5000
Bánh ít
1
2000
Ít gai
Bánh tét
4
6000
Ít nhân Bánh ít
1
2000
Ít gai
Thịt chó
1
7000
Bánh ít
1
2000
Ít gai
Bánh ít
2
2000
Ít gai |==> Bánh ít
1
2000
Ít gai
Bánh chưng
1
5000
Bánh tét
1
6000
Ít nhân
Bánh tét
1
6000
Ít nhân
Bánh tét
1
6000
Ít nhân
Bánh tét
1
6000
Ít nhân
Thịt chó
1
7000

Con chào Bác SA_DQ, ủa con chạy code của Bác con thấy kết quả y chang kết quả của Bác rồi mà.

SA_DQ · 18/4/20

. . . ủa con chạy code của Bác con thấy kết quả y chang kết quả của Bác rồi mà.

Nếu có 2 dòng bánh ít ở 2 dòng xa nhau thì chưa theo iêu cầu dồn các dòng cùng loại hàng lại với nhau đâu.

Hoàng Nhật Phương · 18/4/20

SA_DQ đã viết:
Nếu có 2 dòng bánh ít ở 2 dòng xa nhau thì chưa theo iêu cầu dồn các dòng cùng loại hàng lại với nhau đâu.

Nếu vậy chỉ cần thêm một câu lệnh sắp theo mã hàng sau khi đập kết quả từ mảng xuống sheet là được ạ.

Mọi người giúp mình tách tên hàng theo từng số lượng

Thành viên bị đình chỉ hoạt động

File đính kèm

Ăn cùng góc phố

/(hông là gì!

Gội rồi mới Cạo

Thành viên bị đình chỉ hoạt động

Ăn cùng góc phố

Gội rồi mới Cạo

Ăn cùng góc phố

Thành viên bị đình chỉ hoạt động

Ăn cùng góc phố

Gội rồi mới Cạo

Thành viên gắn bó

Thành viên mới

Thành viên gắn bó

Thành viên mới

Thành viên gắn bó

/(hông là gì!

Thành viên gắn bó

/(hông là gì!

Thành viên gắn bó