code chọn năm thì lọc ra tồn, nhập, xuất và tồn cuối của năm đó

Liên hệ QC
NguyenthiH

NguyenthiH

Thành viên mới đăng ký
Tham gia
11/12/16
Bài viết
965
Được thích
175
Giới tính
Nữ
Chào mọi người!
Em có file này, ở sheet1 là dữ liệu của 3 năm, em muồn là khi chọn năm ở Datavalidation ở Sheet1!P2 thì hiện dữ lieu lọc vào Sheet1!P3:AB như em có mẫu. Em nhờ viết code để tình tồn đầu của từng năm như em làm mẫu ở 3 sheet: 2017,2018,2019.
Em cám ơn mọi người.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
NguyenthiH đã viết:
Chào mọi người!
Em có file này, ở sheet1 là dữ liệu của 3 năm, em muồn là khi chọn năm ở Datavalidation ở Sheet1!P2 thì hiện dữ lieu lọc vào Sheet1!P3:AB như em có mẫu. Em nhờ viết code để tình tồn đầu của từng năm như em làm mẫu ở 3 sheet: 2017,2018,2019.
Em cám ơn mọi người.
Nhấp chuột vào đây để mở rộng...
Sự kiện cho sheet1
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Nam
  If Target.Address = "$P$2" Then
    Nam = Target.Value2
    If Len(Nam) > 0 Then
      Range("Q5") = Nam - 1
      Call TonDauNam(Nam)
    End If
  End If
End Sub
Private Sub TonDauNam(ByVal Nam As Long)
  Dim sArr(), Res()
  Dim i As Long, j As Long, Dau As Long
  Dim NamGoc As Long, tmp
 
  sArr = Range("A6", Range("M1000000").End(xlUp)).Value
  Res = Range("D5:M5").Value
  NamGoc = Range("B5").Value
  Dau = 1
 
  For i = 1 To UBound(sArr)
    tmp = sArr(i, 1)
    If TypeName(tmp) = "Date" Then
      tmp = Year(tmp)
      If tmp > NamGoc Then
        If tmp <= Nam Then
          For j = 1 To UBound(Res, 2)
            If IsNumeric(sArr(i, j + 3)) Then
              Res(1, j) = Res(1, j) + sArr(i, j + 3) * Dau
            End If
          Next j
        End If
      End If
    Else
      If UCase(tmp) Like "T?NG NH?P" Then Dau = -1
    End If
  Next i
  Range("S5:AB5") = Res
End Sub
Sub chạy số dư đầu cho các sheet còn lại
Mã: 
Sub TonNhieuNam()
  Dim sArr(), Res17(), Res18(), Res19()
  Dim i As Long, Dau As Long
  Dim NamGoc As Long, tmp
  With Sheets("Sheet1")
    sArr = .Range("A6", .Range("M1000000").End(xlUp)).Value
    Res17 = .Range("D5:M5").Value
    Res18 = .Range("D5:M5").Value
    Res19 = .Range("D5:M5").Value
    NamGoc = .Range("B5").Value
  End With
  Dau = 1
  For i = 1 To UBound(sArr)
    tmp = sArr(i, 1)
    If TypeName(tmp) = "Date" Then
      tmp = Year(tmp)
      If tmp > NamGoc Then
        If tmp <= 2017 Then Res17 = GanKetQua(sArr, Dau, Res17, i)
        If tmp <= 2018 Then Res18 = GanKetQua(sArr, Dau, Res18, i)
        If tmp <= 2019 Then Res19 = GanKetQua(sArr, Dau, Res19, i)
      End If
    Else
      If UCase(tmp) Like "T?NG NH?P" Then Dau = -1
    End If
  Next i
  Sheets("2017").Range("D5:M5") = Res17
  Sheets("2018").Range("D5:M5") = Res18
  Sheets("2019").Range("D5:M5") = Res19
End Sub
Private Function GanKetQua(ByRef sArr, ByRef Dau, ByVal Res As Variant, ByVal i As Long)
  Dim j As Long
  For j = 1 To UBound(Res, 2)
    If IsNumeric(sArr(i, j + 3)) Then
      Res(1, j) = Res(1, j) + sArr(i, j + 3) * Dau
    End If
  Next j
  GanKetQua = Res
End Function
Nhập và xuất trong kỳ, bạn tự viết code
 

File đính kèm

Upvote 0
Chưa đúng anh Hiếu Ơi!!!
Số tồn đầu năm sai,ví dụ như năm 2017 thì tồn năm 2016 là chỉ có 2 mục sau là có tồn 400 thôi. Mong anh Hiếu xem lại dùm.
 
Upvote 0
NguyenthiH đã viết:
Chưa đúng anh Hiếu Ơi!!!
Số tồn đầu năm sai,ví dụ như năm 2017 thì tồn năm 2016 là chỉ có 2 mục sau là có tồn 400 thôi. Mong anh Hiếu xem lại dùm.
Nhấp chuột vào đây để mở rộng...
Số thì ổn rồi chỉ có ô Q5 của sheet1 là số tồn cuối của năm hiện ra, nếu là số đầu năm thì chỉnh
Mã: 
    If Len(Nam) > 0 Then
      Range("Q5") = Nam - 1
      Call TonDauNam(Nam)
    End If
Thành
Mã: 
    If Len(Nam) > 0 Then
      Range("Q5") = Nam
      Call TonDauNam(Nam)
    End If
 
Upvote 0
Vẫn chưa đúng anh Hiếu ơi! Tức là bỏ đi (-1), thì năm lại là năm chọn, Ví dụ như em chọn năm 2017 thì Q5 phải là 2016 và S5 ->AB5 phải là tồn cuối của năm 2016 (chỉ có AA, và Ab là có SL 400) .Anh hiếu coi lại dùm em
 
Upvote 0
NguyenthiH đã viết:
Vẫn chưa đúng anh Hiếu ơi! Tức là bỏ đi (-1), thì năm lại là năm chọn, Ví dụ như em chọn năm 2017 thì Q5 phải là 2016 và S5 ->AB5 phải là tồn cuối của năm 2016 (chỉ có AA, và Ab là có SL 400) .Anh hiếu coi lại dùm em
Nhấp chuột vào đây để mở rộng...
Chỉnh lại
If tmp < Nam Then
Mã: 
Private Sub TonDauNam(ByVal Nam As Long)
  Dim sArr(), Res()
  Dim i As Long, j As Long, Dau As Long
  Dim NamGoc As Long, tmp
 
  sArr = Range("A6", Range("M1000000").End(xlUp)).Value
  Res = Range("D5:M5").Value
  NamGoc = Range("B5").Value
  Dau = 1
 
  For i = 1 To UBound(sArr)
    tmp = sArr(i, 1)
    If TypeName(tmp) = "Date" Then
      tmp = Year(tmp)
      If tmp > NamGoc Then
        If tmp < Nam Then
          For j = 1 To UBound(Res, 2)
            If IsNumeric(sArr(i, j + 3)) Then
              Res(1, j) = Res(1, j) + sArr(i, j + 3) * Dau
            End If
          Next j
        End If
      End If
    Else
      If UCase(tmp) Like "T?NG NH?P" Then Dau = -1
    End If
  Next i
  Range("S5:AB5") = Res
End Sub
If tmp < 2017 Then Res17 = GanKetQua(sArr, Dau, Res17, i)
If tmp < 2018 Then Res18 = GanKetQua(sArr, Dau, Res18, i)
If tmp < 2019 Then Res19 = GanKetQua(sArr, Dau, Res19, i)
Mã: 
Sub TonNhieuNam()
  Dim sArr(), Res17(), Res18(), Res19()
  Dim i As Long, Dau As Long
  Dim NamGoc As Long, tmp
  With Sheets("Sheet1")
    sArr = .Range("A6", .Range("M1000000").End(xlUp)).Value
    Res17 = .Range("D5:M5").Value
    Res18 = .Range("D5:M5").Value
    Res19 = .Range("D5:M5").Value
    NamGoc = .Range("B5").Value
  End With
  Dau = 1
  For i = 1 To UBound(sArr)
    tmp = sArr(i, 1)
    If TypeName(tmp) = "Date" Then
      tmp = Year(tmp)
      If tmp > NamGoc Then
        If tmp < 2017 Then Res17 = GanKetQua(sArr, Dau, Res17, i)
        If tmp < 2018 Then Res18 = GanKetQua(sArr, Dau, Res18, i)
        If tmp < 2019 Then Res19 = GanKetQua(sArr, Dau, Res19, i)
      End If
    Else
      If UCase(tmp) Like "T?NG NH?P" Then Dau = -1
    End If
  Next i
  Sheets("2017").Range("D5:M5") = Res17
  Sheets("2018").Range("D5:M5") = Res18
  Sheets("2019").Range("D5:M5") = Res19
End Sub
 
Upvote 0
nếu chọn năm 2017 thì đúng phải là:
215239
của anh là (không đúng)
215240
 
Upvote 0
chết .. chết. 3 sheet đó em đưa ra chỉ để là mẫu thôi, chứ không dùng, chỉ dùng một sheet1, ý là em nhập liệu vào sheet1 (dữ liệu có thể nhiều năm, trong file là 3 năm) và khi có người hỏi muốn biết dữ liệu của năm nào thì em chọn năm trong P2 của sheet1 và hiện lên bảng ở P3->AB của sheet1, em đã xóa 3 sheet đó rồi. Mong anh thứ lỗi.
 
Upvote 0
File mới của anh cũng chưa đúng, mới chỉ đúng phần tồn cón phần dữ liệu nhập, xuất chỉ chết năm 2018
 
Upvote 0
Em xin đưa lại File mà em có ghi chú trong sheet1.
3 sheet 2017,2018,2019 chỉ là sheet mẫu để hiện lên giống như vậy chứ không phải để tính toán. (File của anh Hiếu không lọc phần nhập, xuất theo năm lọc.)Mong anh Hiếu xem giúp.
 

File đính kèm

Upvote 0
Em không biết viết anh Hiếu Ơi.
Bài đã được tự động gộp:

Mong anh giúp em với.
 
Lần chỉnh sửa cuối:
Upvote 0
NguyenthiH đã viết:
Em không biết viết anh Hiếu Ơi.
Bài đã được tự động gộp:

Mong anh giúp em với.
Nhấp chuột vào đây để mở rộng...
Góp ý em
từ từ đừng manh động thay đổi code không phải một sớm một chiều khi một cấu trúc dữ liệu thay đổi
HieuCD đã viết:
Ngay từ đầu mình bảo bạn tự viết phần nhập xuất mờ
Nhấp chuột vào đây để mở rộng...
Trích dẫn từ bài #12 là em đã hiểu ý anh @HieuCD nói rồi đó, nên đừng vội.
 
Upvote 0
Thật sự em không hiểu ý của anh LamNA????
 
Upvote 0
NguyenthiH đã viết:
Em không biết viết anh Hiếu Ơi.
Bài đã được tự động gộp:

Mong anh giúp em với.
Nhấp chuột vào đây để mở rộng...
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Nam, i
  If Target.Address = "$P$2" Then
    Nam = Target.Value2
    If Len(Nam) > 0 Then
      Range("Q5") = Nam - 1
      i = Range("P1000000").End(xlUp).Row
      If i > 5 Then Range("P6:AB" & i).Clear
      Call Loc(Nam)
    End If
  End If
End Sub
Private Sub Loc(ByVal Nam As Long)
  Dim sArr(), TonDau(), Nhap(), tNhap(), Xuat(), tXuat()
  Dim i As Long, k1 As Long, k2 As Long, j As Long, sRow As Long, sCol As Long
  Dim NamGoc As Long, tmp, Dau As Long
 
  sArr = Range("A6", Range("M1000000").End(xlUp)).Value
  sRow = UBound(sArr):      sCol = UBound(sArr, 2)
  ReDim Nhap(1 To sRow, 1 To sCol)
  ReDim tNhap(1 To 1, 1 To sCol)
  ReDim Xuat(1 To sRow, 1 To sCol)
  ReDim tXuat(1 To 2, 1 To sCol)
  TonDau = Range("D5:M5").Value
  NamGoc = Range("B5").Value
  Dau = 1
 
  For i = 1 To sRow
    tmp = sArr(i, 1)
    If TypeName(tmp) = "Date" Then
      tmp = Year(tmp)
      If tmp > NamGoc Then
        If tmp < Nam Then
          For j = 1 To UBound(TonDau, 2)
            If IsNumeric(sArr(i, j + 3)) Then
              TonDau(1, j) = TonDau(1, j) + sArr(i, j + 3) * Dau
            End If
          Next j
        ElseIf tmp = Nam Then
          If Dau = 1 Then
            k1 = k1 + 1
            For j = 1 To sCol
              Nhap(k1, j) = sArr(i, j)
              If IsNumeric(sArr(i, j)) And j > 3 Then tNhap(1, j) = tNhap(1, j) + sArr(i, j)
            Next j
          Else
            k2 = k2 + 1
            For j = 1 To sCol
              Xuat(k2, j) = sArr(i, j)
              If IsNumeric(sArr(i, j)) And j > 3 Then tXuat(1, j) = tXuat(1, j) + sArr(i, j)
            Next j
          End If
        End If
      End If
    Else
      If UCase(tmp) Like "T?NG NH?P" Then Dau = -1: tNhap(1, 1) = tmp
      If UCase(tmp) Like "T?NG XU?T" Then tXuat(1, 1) = tmp
      If UCase(tmp) Like "T?N CU?I" Then tXuat(2, 1) = tmp
    End If
  Next i
  For j = 4 To sCol
    tXuat(2, j) = tNhap(1, j) + TonDau(1, j - 3) - tXuat(1, j)
  Next j
  Range("S5:AB5") = Res
  Range("P6:AB6").Resize(k1) = Nhap
  Range("P6:AB6").Offset(k1 + 1) = tNhap
  Range("P6:AB6").Offset(k1 + 2).Resize(k2) = Xuat
  Range("P6:AB6").Offset(k1 + k2 + 3).Resize(2) = tXuat
End Sub
 
Upvote 0
Sao em chép code mới vào thì dòng tồn năm (S5:AB5) lại không có số lượng. Mong anh Hiếu xem giúp và anh cho có border và số có dấu phân cách hàng ngàn luôn ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
NguyenthiH đã viết:
Sao em chép code mới vào thì dòng tồn năm (S5:AB5) lại không có số lượng. Mong anh Hiếu xem giúp và anh cho có border và số có dấu phân cách hàng ngàn luôn ạ.
Nhấp chuột vào đây để mở rộng...
Chỉnh còn sót
Range("S5:AB5") = Res
thay bằng
Range("S5:AB5") = TonDau

"border và số có dấu phân cách hàng ngàn" dùng bộ thu macro và tự chỉnh xem sao
 
Upvote 0
em làm như vầy thấy chạy cũng được, nhưng không biết có sai gì không?Anh Hiếu có thể cho ý kiến hay rút gọn dùm em:
Mã: 
  Range("S5:AB5") = TonDau
  Range("P6:AB6").Resize(k1) = Nhap
  Range("P6:AB6").Offset(k1 + 1) = tNhap
  Range("P6:AB6").Offset(k1 + 2).Resize(k2) = Xuat
  Range("P6:AB6").Offset(k1 + k2 + 3).Resize(2) = tXuat
  Range("P6:AB6").Resize((k1) + 1).Borders.LineStyle = 1
  Range("P6:AB6").Offset(k1 + 1).Borders.LineStyle = 1
  Range("P6:AB6").Offset(k1 + 2).Resize((k2) + 1).Borders.LineStyle = 1
  Range("P6:AB6").Offset(k1 + k2 + 3).Resize(2).Borders.LineStyle = 1
  Range("S6:AB100").NumberFormat = "#,##0_); [red] -#,##0"
 
Upvote 0
NguyenthiH đã viết:
em làm như vầy thấy chạy cũng được, nhưng không biết có sai gì không?Anh Hiếu có thể cho ý kiến hay rút gọn dùm em:
Mã: 
  Range("S5:AB5") = TonDau
  Range("P6:AB6").Resize(k1) = Nhap
  Range("P6:AB6").Offset(k1 + 1) = tNhap
  Range("P6:AB6").Offset(k1 + 2).Resize(k2) = Xuat
  Range("P6:AB6").Offset(k1 + k2 + 3).Resize(2) = tXuat
  Range("P6:AB6").Resize((k1) + 1).Borders.LineStyle = 1
  Range("P6:AB6").Offset(k1 + 1).Borders.LineStyle = 1
  Range("P6:AB6").Offset(k1 + 2).Resize((k2) + 1).Borders.LineStyle = 1
  Range("P6:AB6").Offset(k1 + k2 + 3).Resize(2).Borders.LineStyle = 1
  Range("S6:AB100").NumberFormat = "#,##0_); [red] -#,##0"
Nhấp chuột vào đây để mở rộng...
Làm gọn lại
Mã: 
  Range("S5:AB5") = Res
  Range("P6:AB6").Resize(k1) = Nhap
  Range("P6:AB6").Offset(k1 + 1) = tNhap
  Range("P6:AB6").Offset(k1 + 2).Resize(k2) = Xuat
  Range("P6:AB6").Offset(k1 + k2 + 3).Resize(2) = tXuat
 
  i = Range("P1000000").End(xlUp).Row
  Range("P6:AB" & i).Borders.LineStyle = 1
  Range("S6:AB" & i).NumberFormat = "#,##0_); [red] -#,##0; - "
Mã:
 
Upvote 0
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

K
Mong giúp dữ liệu từ trang web sang excel
Trả lời
0
Đọc
30
khanhvinhdai1
K
GPE-Trợ Lý
[GPE] TALK SHOW EXCEL TRONG SẢN XUẤT
    • Thích
Trả lời
0
Đọc
242
GPE-Trợ Lý
GPE-Trợ Lý
T
Bảng tính trợ cấp tinh giản biên chế theo NĐ 108
    • Thích
Trả lời
3
Đọc
1K
trung_bhxh
T
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
Trả lời
0
Đọc
38
trung_bhxh
T
L
Viết phần mềm đánh lô bằng Visual Basic
    • Thích
2 3
Trả lời
52
Đọc
103K
khanhvinhdai1
K
Mewwo98
Thay dấu ngăn cách sau chữ số hàng nghìn, hàng triệu, hàng tỷ trong Mail Merge
Trả lời
5
Đọc
92
ptm0412
ptm0412
Huyen9
Lỗi không mailings được.
Trả lời
3
Đọc
68
vanle33
vanle33
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
310
Đọc
23K
kunkoi9390
K
K
Có ai giúp mình lấy kết quả xổ số miền nam về file excel
Trả lời
0
Đọc
34
khanhvinhdai1
K
ptm0412
  • Question Question
Lấy dữ liệu web nhiều trang về file Excel bằng Power Query
    • Thích
Trả lời
5
Đọc
2K
ptm0412
ptm0412
H
Công thức tìm kết quả
Trả lời
11
Đọc
121
VetMini
V
V
Hàm dò tìm lấy giá trị của lần xuất hiện thứ n trong excel.
Trả lời
9
Đọc
1K
VetMini
V
N
Nhờ các anh chỉ chỉnh lỗi giúp em với ạ, em cảm ơn ạ.
Trả lời
3
Đọc
80
minhminh27
minhminh27
T
File quản lý thiết bị trong trường học!
Trả lời
4
Đọc
137
VetMini
V
Xoainon3005
Xin file mẫu kế hoạch sản xuất theo tháng ngành động cơ
Trả lời
1
Đọc
126
VetMini
V
Momominh
Sơ đồ hàng hóa trong Container
Trả lời
3
Đọc
130
VetMini
V
hungtin1997
  • Question Question
[Hỏi] Tạo Hyperlink đến ô chạy ngang theo cột
Trả lời
6
Đọc
414
A HOANG 620
A
LuuAnh980
Add in tạo QR code miễn phí.
Trả lời
14
Đọc
561
htin1997
htin1997
tramcannt
Các bác cho hỏi làm cách nào để thu nhỏ thanh công thức này với ạ. Em cảm ơn.
Trả lời
2
Đọc
62
Nhattanktnn
Nhattanktnn
S
  • Question Question
Điều chỉnh kích thước dòng tự động theo trang in
Trả lời
5
Đọc
149
HUONGHCKT
H
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom