Chuyện này nếu rõ ràng thì "dễ ẹc".Em xin gởi file đính kèm
Vấn đề này em làm bằng tay quá mệt luôn ạ. Trong khi đó một ngày dữ liệu đưa vào cả mấy ngàn dòng
Không biết VBA có cách nào để giải quyết nó không?
Nhờ mọi người tư vấn giúp em nhé
Chuyện này nếu rõ ràng thì "dễ ẹc".
Nhưng hiện giờ thì hình như chưa rõ, làm rồi làm lại "mắc công"
Ví dụ:
- Chỉ có Sách 1 hoặc Sách 2 nếu thiếu mới chèn thêm dòng, hay Báo Vỡ cũng chèn?
- Dòng 2 Mã A1 - Sách 1 ; Dòng 5 cũng A1 - Sách 1, Chèn vào chỗ nào? Hay dòng nào cũng chèn, chèn dòng trên hay dòng dưới....
- Không rõ ràng nên chạy tét..........
Bạn thử xem theo file:
Macro đã thêm những dòng cần thiết vô bên dưới;Bạn ơi. Mình chạy rồi mà thấy nó không chịu chèn thêm dòng. Vả lại mình muốn nó tự chèn vào trong bảng tính của mình ạ. Nếu nó chèn sang 1 bên thì càng mệt nữa .
Macro đã thêm những dòng cần thiết vô bên dưới;
Sau đó, nếu ta sort lại theo cột [A] thì sẽ đạt iêu cầu của bạn;
À, chưa nhắc bạn là trước khi chạy macro, ta cần xóa các dòng macro đã thêm do lần chạy lần trước!
[Thongbao]Bạn có thể gởi mình cái file không ạ?
MÌnh thử cách của bác ChanhTQ@ rồi nhưng không được[/Thongbao]
Trong file của bạn mã B1 giải quyết ra sao ?Gởi bạn
Vấn đề là nó đã chèn thêm dòng Sách 1 hoặc Sách 2
Tuy nhiên nó chưa giải quyết vấn đề sau
Giả sử có nhiều Sách 1 trong 1 mã hàng thì nó phải cộng Tiền của sách 1 lại rồi xoá hết sách 1 đi. Chỉ tồn tại 1 dòng Sách 1 trong một mã hàng ạ.



Trong file của bạn mã B1 giải quyết ra sao ?
Dòng 8 có Sách 2; dòng 12 có Sach 1. Có chèn không ( nêu chèn thì chèn ra sao ?) hay đưa 2 Sách lại kề nhau hay chẳng làm gì hết
Tốt nhất là bạn đưa kết quả muốn có ngay trong file của bạn
Em đưa file mới lên ạ
Kết quả mong muốn em để ở Sheet thứ 2.
Tuy nhiên thì khi xài VBA em muốn nó thực hiện ngay trên Sheet hiện hành
Anh giúp em với nhé anh.
Ôi quá tuyệt vời luôn
Tuy nhiên em thử nhập như sau:
[TABLE="width: 256"]
[TR]
[TD]Mã hàng[/TD]
[TD]Tên hàng[/TD]
[TD]Giá tiền[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]10
[/TD]
[/TR]
[/TABLE]
Thì kết quả nó :
[TABLE="width: 256"]
[TR]
[TD]Mã hàng[/TD]
[TD]Tên hàng[/TD]
[TD]Giá tiền[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]140[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 2[/TD]
[TD][/TD]
[/TR]
[/TABLE]
Như vậy là Sách 2 không thêm giá trị 0 tiền vào rồi( phải click 2 cú nó mới hiện số 0)
Luôn tiện anh có thể chỉ giúp em là tại sao nó hiểu chỉ cộng giá trị Sách 1 nếu trùng , trong khi đó Vở thì nó không cộng nhỉ? Làm thế nào để phân biệt 2 đối tượng này ạ?
Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), tArr(), I As Long, J As Long, K As Long, N As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
tArr = Range("E3:E4").Value
sArr = Range([A4], [A4].End(xlDown)).Resize(, 3).Value
ReDim dArr(1 To UBound(sArr, 1) * 2, 1 To 3)
For I = 1 To UBound(sArr, 1)
For N = 1 To 2
Tem = sArr(I, 1) & tArr(N, 1)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = sArr(I, 1)
dArr(K, 2) = tArr(N, 1)
dArr(K, 3) = 0 '<------------------------------------------------Nhét thêm dòng này'
End If
Next N
Tem = sArr(I, 1) & sArr(I, 2)
If Dic.Exists(Tem) Then
dArr(Dic.Item(Tem), 3) = dArr(Dic.Item(Tem), 3) + sArr(I, 3)
Else
K = K + 1
For J = 1 To 3
dArr(K, J) = sArr(I, J)
Next J
End If
Next I
[A4:C1000].ClearContents
[A4].Resize(K, 3) = dArr
Set Dic = Nothing
End Sub
Muốn thêm số 0 vào chỗ trống thì tìm trong Sub "nhét" thêm 1 dòng:
"Luôn tiện" thì không thể "luôn" được rồi.PHP:Public Sub GPE() Dim Dic As Object, sArr(), dArr(), tArr(), I As Long, J As Long, K As Long, N As Long, Tem As String Set Dic = CreateObject("Scripting.Dictionary") tArr = Range("E3:E4").Value sArr = Range([A4], [A4].End(xlDown)).Resize(, 3).Value ReDim dArr(1 To UBound(sArr, 1) * 2, 1 To 3) For I = 1 To UBound(sArr, 1) For N = 1 To 2 Tem = sArr(I, 1) & tArr(N, 1) If Not Dic.Exists(Tem) Then K = K + 1 Dic.Add Tem, K dArr(K, 1) = sArr(I, 1) dArr(K, 2) = tArr(N, 1) dArr(K, 3) = 0 '<------------------------------------------------Nhét thêm dòng này' End If Next N Tem = sArr(I, 1) & sArr(I, 2) If Dic.Exists(Tem) Then dArr(Dic.Item(Tem), 3) = dArr(Dic.Item(Tem), 3) + sArr(I, 3) Else K = K + 1 For J = 1 To 3 dArr(K, J) = sArr(I, J) Next J End If Next I [A4:C1000].ClearContents [A4].Resize(K, 3) = dArr Set Dic = Nothing End Sub
Phải "ngâm cứu" thôi.
Tuyệt quá trời luôn anh ơi
Anh ơi cho em hỏi là với file trên mà mình muốn cái nào trùng tên nhau về tên hàng thì đều cộng giá trị lại thì làm như thế nào ạ?
Thêm cái nữa là biểu tượng picture trong file Excel vì sao em không move được ạ? Trong nó có chứa cái gì không anh?
Thật sự em băn khăn quá mà tìm hiểu không ra. Nên rất mong anh chỉ em cụ thể chút được không ạ?
- Từ đầu sao không nói luôn là các mã giống nhau thì cộng chung?
- Cái hình muốn dời đi đâu thì dời, đâu có ai cấm, nhưng bên dưới nó có 2 ô chứa ký tự "Sách 1" và "Sách 2" theo mẫu dữ liệu của bạn.
Xoá 2 ô này là code "tèo"
- Tôi chỉ biết "mò" và viết theo ý "tự hiểu", còn chuyện "chỉ" cụ thể thì "không ổn" rồi.
- Lỗi như trên thì tìm dòng nàyHihi. Dạ em cám ơn anh nhé
Ủa. Nếu dữ liệu ban đầu mà như thế này thì chạy nó báo lỗi anh ơi.
[TABLE="width: 256"]
[TR]
[TD]Mã hàng[/TD]
[TD]Tên hàng[/TD]
[TD]Giá tiền[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]60[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]Vở [/TD]
[TD="align: right"]10[/TD]
[/TR]
[/TABLE]
Anh cho em hỏi là với cách làm trên là mình có 3 cột. Bây giờ nếu dùng nhiều cột hơn thì mình mở rộng khai báo Mảng hay sao ạ?
Ví dụ em muốn nó thực hiện trên 9 cột ạ?
Đừng nói dữ liệu chỉ có 1 dòng à nghe.ReDim dArr(1 To UBound(sArr, 1) * 2, 1 To 3) <------Thay *2 thành *4
Cái gì cần giúp thì đưa dữ liệu giống thật, nói rõ các tình huống dữ liệu thay đổi để người khác giúp 1 lần là xong.
Bạn không tự "chỉnh code" theo ý mình được mà cứ nhờ "cà giựt" từng chút, từng chút... ai theo nỗi.
Tui "dông" đây.
Em xin gởi file cụ thể ạ
Tình hình là em muốn hỏi rồi tự mày mò để làm. Nhưng mà mò 2 hôm nay rồi mà vẫn không thể làm được...
Xin nhờ mọi người giúp em với ạ
File cụ thể? Mấy cột sau toàn số 0 là cụ thể? Sau này nó là Number hay Text? Có thay đổi gì sau khi chạy code không?Em xin gởi file cụ thể ạ
Quá sợ! File trên bài #19 khác, file trong bài này lại khác.
Nếu làm trên bài #19 thì gặp bài này sửa lại từa lưa.
File cụ thể? Mấy cột sau toàn số 0 là cụ thể? Sau này nó là Number hay Text? Có thay đổi gì sau khi chạy code không?
Nếu là Number thì cũng giữ nguyên theo từng dòng hay lại cộng dồn theo mã trùng?
Nếu là Text thì sao? dữ liệu dòng này khác, dòng khác khác, lấy dữ liệu của dòng nào, bỏ dòng nào?
Còn "tùm lum" cái chưa rõ.
File cụ thể? Mấy cột sau toàn số 0 là cụ thể? Sau này nó là Number hay Text? Có thay đổi gì sau khi chạy code không?
Nếu là Number thì cũng giữ nguyên theo từng dòng hay lại cộng dồn theo mã trùng?
Nếu là Text thì sao? dữ liệu dòng này khác, dòng khác khác, lấy dữ liệu của dòng nào, bỏ dòng nào?
Dạ. Em gởi anh
Tình hình là em mò mẫm sửa đoạn code lại thấy nó chạy rồi ạ. Nhưng mà cái cột Mã Code của em mặc định nó phải là dạng Text. Em sửa xong chạy phát nó lại ra định dạng General
Dạ mấy cột sau này nó phụ thuộc cái khác nên để bằng 0 hết anh ơi
Chỉ có cột Đơn Vị và Tên gọi Tắt là Text thôi anh
Anh cho em hỏi là làm sao cho cái Cột Mã Code này có có định dạng Text cái ạ?
Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), tArr(), I As Long, J As Long, K As Long, N As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
tArr = Range("E1:F2").Value
sArr = Range([A6], [A6].End(xlDown)).Resize(, 12).Value
ReDim dArr(1 To UBound(sArr, 1) * 4, 1 To 12)
For I = 1 To UBound(sArr, 1)
For N = 1 To 2
Tem = sArr(I, 2) & tArr(N, 1)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = 1
dArr(K, 2) = sArr(I, 2)
dArr(K, 3) = "02"
dArr(K, 4) = tArr(N, 1)
dArr(K, 5) = [E3].Value
dArr(K, 6) = tArr(N, 2)
For J = 7 To 12
dArr(K, J) = 0
Next J
End If
Next N
Tem = sArr(I, 2) & sArr(I, 4)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
For J = 1 To 12
dArr(K, J) = sArr(I, J)
Next J
Else
dArr(Dic.Item(Tem), 7) = dArr(Dic.Item(Tem), 7) + sArr(I, 7)
End If
Next I
[A6:L100000].ClearContents
Range("C:C").NumberFormat = "@"
[A6].Resize(K, 12) = dArr
Set Dic = Nothing
End Sub