Giúp em lọc điều kiện vòng lặp copyy và past giá trị từ sheet này sang sheet khác (1 người xem)

[traicauhd]

View attachment 136921

[CODE][ATTACH=CONFIG]136921[/ATTACH]

[/CODE]em có 1 file excel gồm 4 sheet
sheet sheet1
sheet 1(2)
sheet 5
sheet 6

công việc ở đây là : tại sheet 1(2) coppy giá trị ô u7 và v7 past sang ô j9 và k9
công việc tiếp theo : sang sheet 6 lọc điều kiện tại ô b7b8 lọc ở sheet sheet 1 coppy vào sheet 6 tại ô a10d10
công việc tiếp theo : sang sheet 1(2) coppy dòng 7 đến dòng 56 past giá trị sang sheet 5 từ dòng 1 đến dòng 50
công việc hoàn thành

tiếp theo vòng lặp lại 110 lần nhưng ô coppy và past thay đổi

công việc ở đây là : tại sheet 1(2) coppy giá trị ô u7+1 và v7+1 past sang ô j9 và k9
công việc tiếp theo : sang sheet 6 lọc điều kiện tại ô b7b8 lọc ở sheet 1 coppy vào sheet 6 tại ô a10d10
công việc tiếp theo : sang sheet 1(2) coppy dòng 7 đến dòng 56 past giá trị sang sheet 5 từ dòng 1+50 đến dòng 50+50
công việc hoàn thành

em cảm ơn và sẽ có hậu tạ nếu được

 

[traicauhd]

em có ghi macro và xóa những macro thừa và được thế này
Sheets("Sheet5").Select
Columns("A:AP").Select
Selection.ClearContents
Sheets("Sheet1 (2)").Select
Range("U7:V7").Select
Selection.Copy
Range("J9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet6").Select
Sheets("Sheet1").Range("A6:E10017").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B7:B8"), CopyToRange:=Range("A10:E10"), Unique:=False
With ActiveWorkbook.Worksheets("Sheet6").Sort
.SetRange Range("A11:E1113")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet1 (2)").Select
Rows("7:56").Select
Selection.Copy
Sheets("Sheet5").Select
Rows("1:1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1 (2)").Select

Sheets("Sheet1 (2)").Select
Range("U8:V8").Select
Selection.Copy
Range("J9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet6").Select
Sheets("Sheet1").Range("A6:E10017").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B7:B8"), CopyToRange:=Range("A10:E10"), Unique:=False
With ActiveWorkbook.Worksheets("Sheet6").Sort
.SetRange Range("A11:E1113")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet1 (2)").Select
Rows("7:56").Select
Selection.Copy
Sheets("Sheet5").Select
Rows("51:51").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1 (2)").Select

Sheets("Sheet1 (2)").Select
Range("U9:V9").Select
Selection.Copy
Range("J9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet6").Select
Sheets("Sheet1").Range("A6:E10017").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B7:B8"), CopyToRange:=Range("A10:E10"), Unique:=False
With ActiveWorkbook.Worksheets("Sheet6").Sort
.SetRange Range("A11:E1113")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet1 (2)").Select
Rows("7:56").Select
Selection.Copy
Sheets("Sheet5").Select
Rows("101:101").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1 (2)").Select

Sheets("Sheet1 (2)").Select
Range("U10:V10").Select
Selection.Copy
Range("J9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet6").Select
Sheets("Sheet1").Range("A6:E10017").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B7:B8"), CopyToRange:=Range("A10:E10"), Unique:=False
With ActiveWorkbook.Worksheets("Sheet6").Sort
.SetRange Range("A11:E1113")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet1 (2)").Select
Rows("7:56").Select
Selection.Copy
Sheets("Sheet5").Select
Rows("151:151").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1 (2)").Select

Sheets("Sheet1 (2)").Select
Range("U11:V11").Select
Selection.Copy
Range("J9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet6").Select
Sheets("Sheet1").Range("A6:E10017").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B7:B8"), CopyToRange:=Range("A10:E10"), Unique:=False
With ActiveWorkbook.Worksheets("Sheet6").Sort
.SetRange Range("A11:E1113")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet1 (2)").Select
Rows("7:56").Select
Selection.Copy
Sheets("Sheet5").Select
Rows("201:201").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1 (2)").Select

Sheets("Sheet1 (2)").Select
Range("U12:V12").Select
Selection.Copy
Range("J9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet6").Select
Sheets("Sheet1").Range("A6:E10017").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B7:B8"), CopyToRange:=Range("A10:E10"), Unique:=False
With ActiveWorkbook.Worksheets("Sheet6").Sort
.SetRange Range("A11:E1113")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet1 (2)").Select
Rows("7:56").Select
Selection.Copy
Sheets("Sheet5").Select
Rows("251:251").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1 (2)").Select

Sheets("Sheet1 (2)").Select
Range("U13:V13").Select
Selection.Copy
Range("J9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet6").Select
Sheets("Sheet1").Range("A6:E10017").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B7:B8"), CopyToRange:=Range("A10:E10"), Unique:=False
With ActiveWorkbook.Worksheets("Sheet6").Sort
.SetRange Range("A11:E1113")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet1 (2)").Select
Rows("7:56").Select
Selection.Copy
Sheets("Sheet5").Select
Rows("301:301").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1 (2)").Select

Sheets("Sheet1 (2)").Select
Range("U14:V14").Select
Selection.Copy
Range("J9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet6").Select
Sheets("Sheet1").Range("A6:E10017").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B7:B8"), CopyToRange:=Range("A10:E10"), Unique:=False
With ActiveWorkbook.Worksheets("Sheet6").Sort
.SetRange Range("A11:E1113")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet1 (2)").Select
Rows("7:56").Select
Selection.Copy
Sheets("Sheet5").Select
Rows("351:351").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1 (2)").Select

Sheets("Sheet1 (2)").Select
Range("U15:V15").Select
Selection.Copy
Range("J9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet6").Select
Sheets("Sheet1").Range("A6:E10017").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B7:B8"), CopyToRange:=Range("A10:E10"), Unique:=False
With ActiveWorkbook.Worksheets("Sheet6").Sort
.SetRange Range("A11:E1113")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet1 (2)").Select
Rows("7:56").Select
Selection.Copy
Sheets("Sheet5").Select
Rows("401:401").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1 (2)").Select

Sheets("Sheet1 (2)").Select
Range("U16:V16").Select
Selection.Copy
Range("J9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet6").Select
Sheets("Sheet1").Range("A6:E10017").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B7:B8"), CopyToRange:=Range("A10:E10"), Unique:=False
With ActiveWorkbook.Worksheets("Sheet6").Sort
.SetRange Range("A11:E1113")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet1 (2)").Select
Rows("7:56").Select
Selection.Copy
Sheets("Sheet5").Select
Rows("451:451").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1 (2)").Select

Sheets("Sheet1 (2)").Select
Range("U17:V17").Select
Selection.Copy
Range("J9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet6").Select
Sheets("Sheet1").Range("A6:E10017").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B7:B8"), CopyToRange:=Range("A10:E10"), Unique:=False
With ActiveWorkbook.Worksheets("Sheet6").Sort
.SetRange Range("A11:E1113")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet1 (2)").Select
Rows("7:56").Select
Selection.Copy
Sheets("Sheet5").Select
Rows("501:501").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1 (2)").Select

Sheets("Sheet1 (2)").Select
Range("U18:V18").Select
Selection.Copy
Range("J9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet6").Select
Sheets("Sheet1").Range("A6:E10017").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B7:B8"), CopyToRange:=Range("A10:E10"), Unique:=False
With ActiveWorkbook.Worksheets("Sheet6").Sort
.SetRange Range("A11:E1113")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet1 (2)").Select
Rows("7:56").Select
Selection.Copy
Sheets("Sheet5").Select
Rows("551:551").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1 (2)").Select

Sheets("Sheet1 (2)").Select
Range("U19:V19").Select
Selection.Copy
Range("J9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet6").Select
Sheets("Sheet1").Range("A6:E10017").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B7:B8"), CopyToRange:=Range("A10:E10"), Unique:=False
With ActiveWorkbook.Worksheets("Sheet6").Sort
.SetRange Range("A11:E1113")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet1 (2)").Select
Rows("7:56").Select
Selection.Copy
Sheets("Sheet5").Select
Rows("601:601").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1 (2)").Select

 

[HungQuoc49]

em có 1 file excel gồm 4 sheet
sheet dulieuchinh
sheet 1
sheet 5
sheet 6

công việc ở đây là : tại sheet 1 coppy giá trị ô u7 và v7 past sang ô j9 và k9
công việc tiếp theo : sang sheet 6 lọc điều kiện tại ô b7b8 lọc ở sheet dulieuchinh coppy vào sheet 6 tại ô a10d10
công việc tiếp theo : sang sheet 1 coppy dòng 7 đến dòng 56 past giá trị sang sheet 5 từ dòng 1 đến dòng 50
công việc hoàn thành

tiếp theo vòng lặp lại 110 lần nhưng ô coppy và past thay đổi

công việc ở đây là : tại sheet 1 coppy giá trị ô u7+1 và v7+1 past sang ô j9 và k9
công việc tiếp theo : sang sheet 6 lọc điều kiện tại ô b7b8 lọc ở sheet dulieuchinh coppy vào sheet 6 tại ô a10d10
công việc tiếp theo : sang sheet 1 coppy dòng 7 đến dòng 56 past giá trị sang sheet 5 từ dòng 1+50 đến dòng 50+50
công việc hoàn thành

em cảm ơn và sẽ có hậu tạ nếu được

Không thấy sheet "dulieuchinh"
Hình như ý tưởng là lọc dữ liệu theo số liệu của cột U và V của sheet1(2) rồi dán vào sheet5.
Nếu vậy có thể có cách khác nhanh hơn.
---

 

[traicauhd]

đúng rùi đó nhung lọc từ mã một chứ không lọc 1 phát luôn

dulieuchinh ( là sheet 1)
con sheet1 là sheet 1 (2)
quên chưa sửa

 

[HungQuoc49]

đúng rùi đó nhung lọc từ mã một chứ không lọc 1 phát luôn

Ok
Theo cách trong file của bạn thì phải dán 110 lần xuống sheet5 nên sẽ rất chậm.
Bạn kiểm tra xem sheet1 có phải là dulieuchinh hay không, nếu đúng thì điều kiện lọc tại cột U và V của sheet1(2) có lẽ là chưa được ăn khớp với dulieuchinh thì phải

 

[traicauhd]

đúng rồi nó phải copyy và past 110 lần
sheet 1 là sheet dulieuchinh
sheet 1(2) = sheep 6 mà nên lọc điều kiện tại sheet 6

 

[HungQuoc49]

đúng rồi nó phải copyy và past 110 lần
sheet 1 là sheet dulieuchinh
sheet 1(2) = sheep 6 mà nên lọc điều kiện tại sheet 6

Điều kiện lọc tại sheet6 nằm tại ô B8 không ăn khớp với mã sản phẩm nào tại sheet1 bạn ah

 

[traicauhd]

tại sheet 1(2) đánh *8102 vào u7 là khớp mà quên không để ý

 

[HungQuoc49]

bạn đánh vào ô u7va v7 là *8102 là ok mà

Bạn cho một vài số liệu giả định phù hợp vào sheet1(2), cột U và V để test code.

 

[traicauhd]

không upload được file mới nên bạn sửa cho mình với tại sheet 1(2)
ô u7 sủa thành *8102
u8 sửa thành *6082
u9 đến u116 xóa hết

 

[traicauhd]

sửa tại sheet 1 (2) ô u 7 là *8102
u8 là *6082
còn lại xóa hêt tại u 9 đến u116
rồi test xem thế nào mình cảm ơn trước

 

[HungQuoc49]

sửa tại sheet 1 (2) ô u 7 là *8102
u8 là *6082
còn lại xóa hêt tại u 9 đến u116
rồi test xem thế nào mình cảm ơn trước

Bạn nhập số liệu chính xác tại sheet1(2) cột U và V rồi hãy chạy code

Private DL, Mau, kq(), r As Long, c As Long, i As Long

Public Sub Loc_Dan()
On Error Resume Next

Sheets("sheet5").UsedRange.Clear
With Sheets("Sheet1 (2)")
For r = 7 To .Range("U1000000").End(xlUp).Row
.Range("J9").Value = .Range("U" & r).Value
.Range("K9").Value = .Range("V" & r).Value
Application.Run "Loc"
Application.Run "Dan"
Next r
End With

End Sub

Public Sub Loc()
On Error Resume Next
Mau = Sheets("sheet6").Range("B8")
DL = Sheets("Sheet1").Range("A9", Sheet1.Range("D1000000").End(xlUp))
ReDim kq(1 To UBound(DL), 1 To UBound(DL, 2))

i = 0
For r = 1 To UBound(DL)
If DL(r, 2) = Mau Then
i = i + 1

For c = 1 To UBound(DL, 2)
kq(i, c) = DL(r, c)
Next c

End If
Next r
Sheets("sheet6").Range("A11:D120").Clear   'BS
Sheets("sheet6").Range("A11").Resize(i, UBound(kq, 2)).Value = kq
End Sub

Public Sub Dan()
DL = Sheets("Sheet1 (2)").Range("A7:V56")
Sheets("sheet5").Range("A1000000").End(xlUp).Offset(1).Resize(50, UBound(DL, 2)).Value = DL
End Sub

---
Chạy sub Loc_Dan

 

[traicauhd]

ok rồi nhưng mình muốn nó chạy một mạch luôn không chia làm 3

 

[traicauhd]

chạy code loc_dan được nhưng code sau không chạy

 

[traicauhd]

giúp mình với mình muốn gộp 3 cái thành 1
ghĩa là copyy rồi lọc xong rui copyy
cứ thế lặp lại 110 lần

 

[traicauhd]

ai giúp em với em không chạy được code trên

 

[HungQuoc49]

ai giúp em với em không chạy được code trên

Bạn gửi file lên để kiểm tra xem lỗi ở đâu rồi tính tiếp

 

[traicauhd]

sửa lại file nhe aaaaaaaaaaaaaaaaaa

 

[traicauhd]

Bạn gửi file lên để kiểm tra xem lỗi ở đâu rồi tính tiếp

nó chỉ chạy được một mã thôi không chạy những mã khác

 

[HungQuoc49]

nó chỉ chạy được một mã thôi không chạy những mã khác

Đã chỉnh lại code chạy theo yêu cầu.
( Sửa hơi ngại, vẫn để 3 sub nhưng chạy tốt )
Bạn lắp 110 dữ liệu rồi kiểm tra xem cần bổ sung gì nữa không

 

[traicauhd]

Đã chỉnh lại code chạy theo yêu cầu.
( Sửa hơi ngại, vẫn để 3 sub nhưng chạy tốt )
Bạn lắp 110 dữ liệu rồi kiểm tra xem cần bổ sung gì nữa không

ok rồi nhưng còn một vấn đề là mình cần chay xong code lọc thì nó sắp xếp thứ tự tại sheet 6 cột c
ở trong khoảng a11 d100
rùi mới chạy code dan

kết thúc thì hiện thông báo hoàn thành là ok

 

[HungQuoc49]

ok rồi nhưng còn một vấn đề là mình cần chay xong code lọc thì nó sắp xếp thứ tự tại sheet 6 cột c
ở trong khoảng a11 d100
rùi mới chạy code dan

kết thúc thì hiện thông báo hoàn thành là ok

Bạn chạy thử với dữ liệu lớn hơn & kiểm tra xem còn cần bổ sung gì sẽ xử lý nốt!.

 

[traicauhd]

tại sheet 5 mình cần nó coppy hết dữ liệu tại sheet1(2)

 

[HungQuoc49]

tại sheet 5 mình cần nó coppy hết dữ liệu tại sheet1(2)

Đang thắc mắc là vùng bạn muốn copy trong sheet1(2) là từ
- Cột nào tới cột nào ( VD : Từ cột A đến R hay là từ A tới V )
- Từ dòng nào tới dòng nào ( VD từ dòng 7 tới 56 như bài 1 ) hay là chỉ copy các dòng có kết quả sau khi lọc ( VD lọc được 2 kết quả phù hợp thì tính là 2 dòng )

02 Ý trên bạn làm rõ thì chỉnh code tí tẹo là xong

 

[traicauhd]

Đang thắc mắc là vùng bạn muốn copy trong sheet1(2) là từ
- Cột nào tới cột nào ( VD : Từ cột A đến R hay là từ A tới V )
- Từ dòng nào tới dòng nào ( VD từ dòng 7 tới 56 như bài 1 ) hay là chỉ copy các dòng có kết quả sau khi lọc ( VD lọc được 2 kết quả phù hợp thì tính là 2 dòng )

02 Ý trên bạn làm rõ thì chỉnh code tí tẹo là xong

copyy tu a tới v và từ 7 đến 56 la ok

 

[HungQuoc49]

copyy tu a tới v và từ 7 đến 56 la ok

Bạn kiểm tra xem sao.
Hy vọng là ok
---
quên sửa không có nút bấm, dùng alt+F8 thay thế vậy

 

[traicauhd]

Bạn kiểm tra xem sao.
Hy vọng là ok
---
quên sửa không có nút bấm, dùng alt+F8 thay thế vậy

file mới mình thêm mấy dòng nên bị lỗi nhờ bạn sửa lại code cho mình với

 

[HungQuoc49]

file mới mình thêm mấy dòng nên bị lỗi nhờ bạn sửa lại code cho mình với

Có một vài ý như sau:
1. Vì chèn thêm cột nên số liệu nạp vào mảng trong sub bị lệch
2. Trong sheet1(2), cột U, U16=IFERROR(#REF!,0) nên đổi thành U16=IFERROR(#REF!,"")
3. Trong sheet1(2), cột C, hình như công thức bị sai
Theo trong file C7=IF(Sheet6!N11>0,Sheet6!N11,"")<---Cột N trong sheet6 không phải mã sản phẩm
Sửa tạm lại C7==IF(Sheet6!C11>0,Sheet6!C11,"")
4. Dữ liệu lọc xong, dán vào sheet5 có một vài dòng thấy là "không có ý nghĩa" ( Dòng rỗng ).
Cái này tùy bạn quyết định.

Các ý 1_3 đã sửa
Ý 4 tùy bạn lựa chọn
--
Những module không cần thiết thì xóa cho dễ kiểm tra
Có lẽ nên có file có cấu trúc y như thật sẽ là tốt nhất.
Nhấn alt+F8 chạy sub Thong_Ke_Ton_Kho rồi kiểm tra xem sao nhé!

 

[traicauhd]

Có một vài ý như sau:
1. Vì chèn thêm cột nên số liệu nạp vào mảng trong sub bị lệch
2. Trong sheet1(2), cột U, U16=IFERROR(#REF!,0) nên đổi thành U16=IFERROR(#REF!,"")
3. Trong sheet1(2), cột C, hình như công thức bị sai
Theo trong file C7=IF(Sheet6!N11>0,Sheet6!N11,"")<---Cột N trong sheet6 không phải mã sản phẩm
Sửa tạm lại C7==IF(Sheet6!C11>0,Sheet6!C11,"")
4. Dữ liệu lọc xong, dán vào sheet5 có một vài dòng thấy là "không có ý nghĩa" ( Dòng rỗng ).
Cái này tùy bạn quyết định.

Các ý 1_3 đã sửa
Ý 4 tùy bạn lựa chọn
--
Những module không cần thiết thì xóa cho dễ kiểm tra
Có lẽ nên có file có cấu trúc y như thật sẽ là tốt nhất.
Nhấn alt+F8 chạy sub Thong_Ke_Ton_Kho rồi kiểm tra xem sao nhé!

ok rồi nhưng mà có một phát sinh là nếu điều kiện lọc =0 thì kết thúc quá trình lọc có được không

 

[traicauhd]

file excel nhiều sheet quá nên phải xóa một số sheet đi để upload nên . nên phat sinh công thức lỗi

 

[HungQuoc49]

ok rồi nhưng mà có một phát sinh là nếu điều kiện lọc =0 thì kết thúc quá trình lọc có được không

Đoạn sub trong file đính kèm của bài 28 đã bổ sung

On Error Resume Next

nên đ/k lọc =0 vẫn chạy nhưng chậm vì phải dán mảng lớn hơn
Ngắn gọn là ra kết quả nhưng chậm

 

[traicauhd]

Đoạn sub trong file đính kèm của bài 28 đã bổ sung

On Error Resume Next

nên đ/k lọc =0 vẫn chạy nhưng chậm vì phải dán mảng lớn hơn
Ngắn gọn là ra kết quả nhưng chậm

còn 1 vấn đề mình lấy dữ liệu tại sheet 5 nhưng mà bạn lại xóa dòng tại sheet 5 nên mất hết công thức ở sheet khác
có thể không xóa dòng mà chỉ xóa dữ liệu thôi

 

[traicauhd]

còn 1 vấn đề mình lấy dữ liệu tại sheet 5 nhưng mà bạn lại xóa dòng tại sheet 5 nên mất hết công thức ở sheet khác
có thể không xóa dòng mà chỉ xóa dữ liệu thô

 

[HungQuoc49]

còn 1 vấn đề mình lấy dữ liệu tại sheet 5 nhưng mà bạn lại xóa dòng tại sheet 5 nên mất hết công thức ở sheet khác
có thể không xóa dòng mà chỉ xóa dữ liệu thô

Bạn dán đoạn code này vào module
( Đoạn code có thêm tham số j, các phần khác không thay đổi )
Kết quả thu được sẽ bị cách quãng

Public Sub Thong_Ke_Ton_Kho()
Dim DL, Kq(), r As Long, rw As Long, c As Long, i, j
On Error Resume Next
'NAP SO LIEU CUA SHEET1 VAO MANG DL, SAU DO SORT
'Nap so lieu cua sheet1 vao mang DL
DL = Sheet1.Range("A9", Sheet1.Range("E1000000").End(xlUp))
'Khai bao mang Kq
ReDim Kq(1 To 1, 1 To UBound(DL, 2))

'Sort mang DL theo Lot No
For r = 1 To UBound(DL)
For c = 1 To UBound(DL, 2)
Kq(1, c) = DL(r, c)
Next c

For rw = r + 1 To UBound(DL)
If Kq(1, 4) > DL(rw, 4) Then
For c = 1 To UBound(DL, 2)
Kq(1, c) = DL(rw, c)
DL(rw, c) = DL(r, c)
DL(r, c) = Kq(1, c)
Next c
End If
Next rw
Next r

Application.ScreenUpdating = False
'LOC VA DAN
'Xoa toan bo cac dong cua sheet13
Sheet13.UsedRange.ClearContents
j = 1
With Sheet8
'Quet vung dieu kien, nap vao J9 va K9
For r = 7 To .Range("U1000000").End(xlUp).Row
.Range("J9").Value = .Range("U" & r)
.Range("K9").Value = .Range("V" & r)
Sheet14.Range("A11:D120").ClearContents

ReDim Kq(1 To UBound(DL), 1 To UBound(DL, 2))
i = 0
'Loc DL theo J9
For rw = 1 To UBound(DL)
If DL(rw, 3) = .Range("J9") Then
i = i + 1
For c = 1 To UBound(DL, 2)
Kq(i, c) = DL(rw, c)
Next c
End If
Next rw
'Dan ket qua loc vao sheet14
Sheet14.Range("A11").Resize(i, UBound(Kq, 2)).Value = Kq
'Lay ket qua cua sheet8
Kq = .Range("A7", "V56")
'Dan ket qua tu sheet8 vao sheet13
Sheet13.Range("A" & j + 1).Resize(UBound(Kq, 1), UBound(Kq, 2)).Value = Kq
j = j + UBound(Kq, 1)
Next r
End With

Sheet13.Range("A1:V1") = Sheet8.Range("A4:V4").Value
Sheet13.UsedRange.Font.ColorIndex = 0
Sheet13.UsedRange.Columns.AutoFit
Application.ScreenUpdating = True
Beep
MsgBox "HOÀN THÀNH"
End Sub

 

[traicauhd]

ok rồi nhưng mà khi chạy macro không biết đến bao giờ thì xong
mình muốn nó hiện % khi chạy macro ví dụ như 1% rồi 2% cú thế đến 100% là hoàn thành
chậm một tý cũng được

 

[HungQuoc49]

ok rồi nhưng mà khi chạy macro không biết đến bao giờ thì xong
mình muốn nó hiện % khi chạy macro ví dụ như 1% rồi 2% cú thế đến 100% là hoàn thành
chậm một tý cũng được

Cái này thì ngoài tầm với rồi.
Bạn có thể tham khảo ở đây xem sao.
http://www.giaiphapexcel.com/forum/showthread.php?11063-Tạo-thanh-Progress-Bar

 

[giola]

ok rồi nhưng mà khi chạy macro không biết đến bao giờ thì xong
mình muốn nó hiện % khi chạy macro ví dụ như 1% rồi 2% cú thế đến 100% là hoàn thành
chậm một tý cũng được

Tham khảo cái này và làm theo cho dễ dàng

http://www.excel-easy.com/vba/examples/progress-indicator.html

Chắc với trình độ code, bạn ứng dụng vào tốt (vì thấy trong file của bạn nhiều code nhiều)

 

[traicauhd]

bó tay không làm được . ai giúp mình với

 

[giola]

bó tay không làm được . ai giúp mình với

Định giúp bạn, nhưng bạn nói thế này, thì đúng là bó tay (vì chính bạn không thử làm và nỗ nực giải quyết vấn đề của chính ta), và 1 lý do lớn nữa đó là:

Dữ liệu có mấy dòng, code trên chạy chút là xong, vậy cần gì progress bar - vì progress bar thường cho tiến trình các code chạy thời gian dài, giúp NSD biết tiến trình đang thực hiệnd dến đâu (nhanh quá thì hiện form lên, tắt form là xong)

Đọc lại từ post#1 thấy bài của bạn đang có code và công thức và lọc và fill lẫn lộn, và dữ liệu thì sơ sài đặt vấn đề thì không rõ dàng, dẫn đến mọi thứ nửa vời.

hết