Hoàn thiện code phiếu nhập (2 người xem)

  • Thread starter Thread starter yome
  • Ngày gửi Ngày gửi
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)
yome

yome

GPE thật tuyệt vời
Tham gia
9/5/08
Bài viết
347
Được thích
113
Anh chị hoàn thiện thêm dùm em code cho phiếu nhập này.
(Câu hỏi cụ thể trong file đính kèm)
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
yome đã viết:
Anh chị hoàn thiện thêm dùm em code cho phiếu nhập này.
(Câu hỏi cụ thể trong file đính kèm)
Nhấp chuột vào đây để mở rộng...
Nếu không có gì cần thiết lắm, bạn có thể dùng VLOOKUP cho toàn bộ yêu cầu ---> Tôi thấy cũng chả có gì cả!
Còn nếu nhất định dùng code thì thêm đoạn này ở đầu code:
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim FRng As Range
  If Target.Address = "$G$1" Then
     '..........
    With Sheets("DATA_VT")
      .ShowAllData
      Set FRng = .Range("PNK01").Find(Target, , xlValues, xlWhole)
      '..........
      '..........
  End If
End Sub
Tìm giá trị cell C8: Range("C8") = FRng.Offset(, 4).Value
Tìm giá trị cell B9: Range("B9") = FRng.Offset(, 5).Value
vân vân
Đại khái thế này:
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim FRng As Range
  If Target.Address = "$G$1" Then
    On Error Resume Next
    Range("A14:H60000").ClearContents
    Set FRng = Range("PNK01").Find(Target, , xlValues, xlWhole)
    With Sheets("DATA_VT")
      .ShowAllData
      Set FRng = .Range("PNK01").Find(Target, , xlValues, xlWhole)
      With .Range(.[A5], .[a65536].End(xlUp)).Resize(, 20)
        .AutoFilter 1, Target.Value
        If .Resize(, 1).SpecialCells(12).Count > 1 Then
          Intersect(.Columns(6), .Offset(1)).Copy: Cells(8, C).PasteSpecial 3
          Intersect(.Columns(13), .Offset(1)).Copy: Range("B14").PasteSpecial 3
          Intersect(.Columns(14), .Offset(1)).Copy: Range("D14").PasteSpecial 3
          Intersect(.Columns(15), .Offset(1)).Copy: Range("G14").PasteSpecial 3
          Intersect(.Columns(IIf(Left(Target, 2) = "PN", 16, 18)), .Offset(1)).Copy
          Range("F14").PasteSpecial 3
       End If
        .AutoFilter
      End With
    End With
    If Range("B14").Value <> "" Then
      With Range([B14], [B65536].End(xlUp))
        .Offset(, -1).Value = Evaluate("ROW(R:R)")
        With .Offset(, 6)
          .Value = "=RC[-1]*RC[-2]"
          .Value = .Value
        End With
      End With
    End If
    Range("C8") = FRng.Offset(, 4).Value
    Range("B9") = FRng.Offset(, 5).Value
    '---> Tiếp cho những cell khác
    Target.Select
  End If
End Sub
Tự bạn nghĩ ra những cell còn lại nhé ---> Cũng chỉ là tính xem phải Offset bao nhiêu cột thôi (tính từ cột A của sheet DATA_VT)
 
Upvote 0
Nếu yêu cầu, mình sẽ tiếp cho fần chi tiết hàng hóa

Còn đây là những gì theo yếu cầu của bạn:

PHP: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [G1]) Is Nothing Then
   Dim Sh As Worksheet, Rng As Range, sRng As Range
   Dim MyAdd As String
   
   Set Sh = Sheets("DATA_VT")
   Set Rng = Sh.Range(Sh.[A5], Sh.[A65500].End(xlUp))
   Set sRng = Rng.Find([G1].Value, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      [c8].Value = Sh.Cells(sRng.Row, "E").Value
      [B9].Value = Sh.Cells(sRng.Row, "K").Value
      [B10].Value = Sh.Cells(sRng.Row, "F").Value
      [E9].Value = Sh.Cells(sRng.Row, "T").Value
      [H6].Value = Sh.Cells(sRng.Row, "C").Value
      [H7].Value = Sh.Cells(sRng.Row, "D").Value
      [G9].Value = Sh.Cells(sRng.Row, "B").Value
      [c11].Value = Sh.Cells(sRng.Row, "I").Value
      [G11].Value = Sh.Cells(sRng.Row, "J").Value
2 ' Chép Chi Tiet Mat Hàng:'
      MyAdd = sRng.Address
      Do
      
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   End If
 End If
End Sub
 
Upvote 0
ChanhTQ@ đã viết:
Còn đây là những gì theo yếu cầu của bạn:

PHP: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [G1]) Is Nothing Then
Dim Sh As Worksheet, Rng As Range, sRng As Range
Dim MyAdd As String
 
Set Sh = Sheets("DATA_VT")
Set Rng = Sh.Range(Sh.[A5], Sh.[A65500].End(xlUp))
Set sRng = Rng.Find([G1].Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
[c8].Value = Sh.Cells(sRng.Row, "E").Value
[B9].Value = Sh.Cells(sRng.Row, "K").Value
[B10].Value = Sh.Cells(sRng.Row, "F").Value
[E9].Value = Sh.Cells(sRng.Row, "T").Value
[H6].Value = Sh.Cells(sRng.Row, "C").Value
[H7].Value = Sh.Cells(sRng.Row, "D").Value
[G9].Value = Sh.Cells(sRng.Row, "B").Value
[c11].Value = Sh.Cells(sRng.Row, "I").Value
[G11].Value = Sh.Cells(sRng.Row, "J").Value
2 ' Chép Chi Tiet Mat Hàng:'
MyAdd = sRng.Address
Do
 
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
End If
End Sub
Nhấp chuột vào đây để mở rộng...

Các thầy viết dùm em code cho Sổ chi tiết này nữa nhé!
Cám ơn các thầy nhiều!
 

File đính kèm

Upvote 0
Dây vẫn là Phiếu nhập kho, nhưng là fần bổ sung để lấy chi tiết hàng

PHP: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [G1]) Is Nothing Then
   Dim Sh As Worksheet, Rng As Range, sRng As Range
   Dim MyAdd As String
 
   Set Sh = Sheets("DATA_VT")
   Set Rng = Sh.Range(Sh.[A5], Sh.[A65500].End(xlUp))
   Set sRng = Rng.Find([G1].Value, , xlFormulas, xlWhole)
   Range("B14:B" & [E65500].End(xlUp).Row).Resize(, 7).ClearContents
   If Not sRng Is Nothing Then
      [c8].Value = Sh.Cells(sRng.Row, "E").Value
      [B9].Value = Sh.Cells(sRng.Row, "K").Value
      [B10].Value = Sh.Cells(sRng.Row, "F").Value
      [E9].Value = Sh.Cells(sRng.Row, "T").Value
      [H6].Value = Sh.Cells(sRng.Row, "C").Value
      [H7].Value = Sh.Cells(sRng.Row, "D").Value
      [G9].Value = Sh.Cells(sRng.Row, "B").Value
      [c11].Value = Sh.Cells(sRng.Row, "I").Value
      [G11].Value = Sh.Cells(sRng.Row, "J").Value
2 ' Chép Chi Tiet Mat Hàng:'
      MyAdd = sRng.Address
      Do
         With Range("B" & [E65500].End(xlUp).Row).Offset(1)
            .Value = Sh.Cells(sRng.Row, "M").Value
            .Offset(, 1).Value = Sh.Cells(sRng.Row, "L").Value
            .Offset(, 2).Value = Sh.Cells(sRng.Row, "N").Value
'            .Offset(, 3).Value ="GPE.COM" '
            .Offset(, 4).Value = Sh.Cells(sRng.Row, "P").Value
            .Offset(, 5).Value = Sh.Cells(sRng.Row, "O").Value
            .Offset(, 6).Value = Sh.Cells(sRng.Row, "Q").Value
         End With
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   End If
 End If
End Sub


Tuy nhiên mình thấy thường mọi người tách fần chung & fần chi tiết của CSDL quản lý vật tư xuất nhập này làm 2 bảng;
Bảng thức nhất là các trường trước trường [MaHangHoa] của trang tính 'DATA_VT';
Bảng thứ hai là các trường còn lại & thêm trường [SoCT] để liên kết với bảng đầu.
Có như vậy, dữ liệu trông gọn gàng, không trùng lắp nhiều trường chung (như các trường ở bảng đầu tiên ta vừa đề cập).
 
Upvote 0
Các thầy viết dùm code cho sổ chi tiết nhé!
Lưu ý: Nếu cột số chứng từ và ngày chứng từ trùng nhau thì lấy giá trị dòng trên thôi. Như vậy nhìn mới thoáng bảng.
Cám ơn các thầy nhiều!
 
Upvote 0
Đây, xin mời bỏ vô trang "SCT"

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [F1]) Is Nothing Then SoChungTu
End Sub
PHP: 
Sub SoChungTu()
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim Jj As Long, SoNg As Long, Rws As Long
 Dim Dat As Date, MyAdd As String
 
 Set Sh = Worksheets("DATA_VT"):            Sheets("SCT").Select
 Dat = [E4].Value:                           SoNg = [h4].Value - Dat
1
 Set Rng = Sh.Range(Sh.[L1], Sh.[L65500].End(xlUp))
 Set sRng = Rng.Find([F1].Value, , xlFormulas, xlWhole)
 If Not sRng Is Nothing Then
   [C6].Value = sRng.Offset(, 1).Value
   [H6].Value = sRng.Offset(, 2).Value 'm3?'
   Jj = sRng.Row:                            [C7].Value = "GPE"  '? O Dau'
   [H7].Value = Sh.Cells(Jj, "I").Value
   [j6].Value = Sh.Cells(Jj, "C").Value         'TKh No'
 End If
2
 Set Rng = Sh.Range(Sh.[B5], Sh.[B65500].End(xlUp))
 Rng.NumberFormat = "dd/mm/yyyy"
 Rows("11:999").ClearContents
 For Jj = 0 To SoNg
   Set sRng = Rng.Find(Dat + Jj)
   If Not sRng Is Nothing Then
      MyAdd = sRng.Address:                  Rws = sRng.Row
      Do
         If Sh.Cells(Rws, "L").Value = [F1].Value Then
         With [A65500].End(xlUp).Offset(1)
               .Value = Sh.Cells(Rws, "A").Value
               .Offset(, 1).Value = Dat + Jj
               .Offset(, 2).Value = [F1].Value
               .Offset(, 3).Value = Sh.Cells(Rws, "k").Value 'DienGiai
               .Offset(, 4).Value = "NTr"
               .Offset(, 5).Value = Sh.Cells(Rws, "d").Value 'TKhDU
               .Offset(, 6).Value = Sh.Cells(Rws, "o").Value 'DonGia
               .Offset(, 7).Value = Sh.Cells(Rws, "p").Value 'SoNhap
               .Offset(, 8).Value = Sh.Cells(Rws, "q").Value 'TriNhap
               .Offset(, 9).Value = Sh.Cells(Rws, "r").Value 'SoXuat
               .Offset(, 10).Value = Sh.Cells(Rws, "s").Value 'TriXuat
               .Offset(, 11).Value = .Offset(, 7).Value - .Offset(, 9).Value
               .Offset(, 12).Value = .Offset(, 8).Value - .Offset(, 10).Value
            End With
         End If
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   End If
 Next Jj
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
ChanhTQ@ đã viết:
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [F1]) Is Nothing Then SoChungTu
End Sub

PHP: 
Sub SoChungTu()
Dim Sh As Worksheet, Rng As Range, sRng As Range
Dim Jj As Long, SoNg As Long, Rws As Long
Dim Dat As Date, MyAdd As String

Set Sh = Worksheets("DATA_VT"): Sheets("SCT").Select
Dat = [E4].Value: SoNg = [h4].Value - Dat
1
Set Rng = Sh.Range(Sh.[L1], Sh.[L65500].End(xlUp))
Set sRng = Rng.Find([F1].Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
[C6].Value = sRng.Offset(, 1).Value
[H6].Value = sRng.Offset(, 2).Value 'm3?'
Jj = sRng.Row: [C7].Value = "GPE" '? O Dau'
[H7].Value = Sh.Cells(Jj, "I").Value
[j6].Value = Sh.Cells(Jj, "C").Value 'TKh No'
End If
2
Set Rng = Sh.Range(Sh.[B5], Sh.[B65500].End(xlUp))
Rng.NumberFormat = "dd/mm/yyyy"
Rows("11:999").ClearContents
For Jj = 0 To SoNg
Set sRng = Rng.Find(Dat + Jj)
If Not sRng Is Nothing Then
MyAdd = sRng.Address: Rws = sRng.Row
Do
If Sh.Cells(Rws, "L").Value = [F1].Value Then
With [A65500].End(xlUp).Offset(1)
.Value = Sh.Cells(Rws, "A").Value
.Offset(, 1).Value = Dat + Jj
.Offset(, 2).Value = [F1].Value
.Offset(, 3).Value = Sh.Cells(Rws, "k").Value 'DienGiai
.Offset(, 4).Value = "NTr"
.Offset(, 5).Value = Sh.Cells(Rws, "d").Value 'TKhDU
.Offset(, 6).Value = Sh.Cells(Rws, "o").Value 'DonGia
.Offset(, 7).Value = Sh.Cells(Rws, "p").Value 'SoNhap
.Offset(, 8).Value = Sh.Cells(Rws, "q").Value 'TriNhap
.Offset(, 9).Value = Sh.Cells(Rws, "r").Value 'SoXuat
.Offset(, 10).Value = Sh.Cells(Rws, "s").Value 'TriXuat
.Offset(, 11).Value = .Offset(, 7).Value - .Offset(, 9).Value
.Offset(, 12).Value = .Offset(, 8).Value - .Offset(, 10).Value
End With
End If
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
Next Jj
End Sub
Nhấp chuột vào đây để mở rộng...

Thầy Chanh ơi, sao em làm theo hướng dẫn của thầy mà không được!? Thầy làm luôn vào file dùm cho em nhé!
(Em đã test nhiều lần rồi mà không được thầy ah!)
 
Upvote 0
@ Yome :
1/ Thà rằng ngay lúc đầu bạn "nhờ các thầy" trên GPE thiết kế giùm em một sổ kế toán trên Ex, chắc sẽ có người "làm giúp"
2/ Nếu không chịu học, chỉ biết đi nhờ vả, chắc đến mùa quýt năm nào đó bạn mới hiểu biết được Ex. Đến khi đó lỡ file có bị lỗi, chắc bạn cũng không biết lỗi ở đâu và ....vẫn nhờ tiếp
3/ Nói riêng : Hãy tự minh làm theo các hướng dẫn, sau đó nếu không hiểu hoặc chưa hiểu chỗ nào thì post bài lên hỏi, như vậy bạn sẽ hiểu sâu hơn và mới biết vận dụng vào bài khác của minh
Một đôi lời giãi bày, mong hiểu. Nếu có điều gì quá lời mong bỏ qua.
Thân
 
Lần chỉnh sửa cuối:
Upvote 0
To Tác giả topic

Mình đã đưa file lên ở #9

(Nhưng vẫn còn lộn xộn chổ ngày hệ Fáp & định dạng ngày hệ Mẽo!)

Xin nhờ các MOD/SMOD ngang qua đây xóa dùm bài này sau 13 giờ
 
Upvote 0
XuanThanh đã viết:
@ Yome :
1/ Thà rằng ngay lúc đầu bạn "nhờ các thầy" trên GPE thiết kế giùm em một sổ kế toán trên Ex, chắc sẽ có người "làm giúp"
2/ Nếu không chịu học, chỉ biết đi nhờ vả, chắc đến mùa quýt năm nào đó bạn mới hiểu biết được Ex. Đến khi đó lỡ file có bị lỗi, chắc bạn cũng không biết lỗi ở đâu và ....vẫn nhờ tiếp
3/ Nói riêng : Hãy tự minh làm theo các hướng dẫn, sau đó nếu không hiểu hoặc chưa hiểu chỗ nào thì post bài lên hỏi, như vậy bạn sẽ hiểu sâu hơn và mới biết vận dụng vào bài khác của minh
Một đôi lời giãi bày, mong hiểu. Nếu có điều gì quá lời mong bỏ qua.
Thân
Nhấp chuột vào đây để mở rộng...

Cám ơn anh Xuan Thanh nhiều! Em cũng đang tìm hiểu nhưng vì việc cũng cần làm ngay nên mới up lên nhờ các anh/chị làm dù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

D
xin hỏi về lỗi mô đun ẩn.
Trả lời
3
Đọc
88
ongke0711
ongke0711
N
Chuyển giờ công từ bảng công vào bảng tính
Trả lời
8
Đọc
156
ngouyen1505
N
H
Xin anh chị hướng dẫn công thức excel ạ.
Trả lời
9
Đọc
223
Phan Thế Hiệp
Phan Thế Hiệp
OverAC
  • Dán lên cao
  • Suggestion Suggestion
Chúc mừng sinh nhật GiaiPhapExcel 19 tuổi và tặng ebook "Lập trình VBA phần cơ bản." (2 người xem)
    • Thích
    • Yêu thích
Trả lời
4
Đọc
1K
LeThangbk
L
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
18 19 20
Trả lời
381
Đọc
44K
tuanktt3
T
M
Add-in Excel kết nối cơ sở dữ liệu (1 người xem)
Trả lời
1
Đọc
49
ptm0412
ptm0412
E
Đánh số cho các cặp số chứng từ và số chứng từ đối ứng
Trả lời
9
Đọc
147
Phan Thế Hiệp
Phan Thế Hiệp
Đ
tách dữ liệu từ một dòng thành hai dòng
Trả lời
2
Đọc
104
Phuocam
Phuocam
longhuy
Lỗi error 20728: F
Trả lời
0
Đọc
54
longhuy
longhuy
H
Trang tính chỉ hiển thị vùng có dữ liệu
Trả lời
7
Đọc
591
vinhkm6
vinhkm6
mrjun80
Có hàm nào đếm tổng các số nằm trong 1 ô không mọi người
Trả lời
12
Đọc
446
Phan Thế Hiệp
Phan Thế Hiệp
N
Hàm DATEDIF trong Excel 2016 (1 người xem)
Trả lời
16
Đọc
14K
Phan Thế Hiệp
Phan Thế Hiệp
N
Tạo COM Add-In bằng Visual C++
    • Thích
Trả lời
6
Đọc
593
nguyendang95
N
Tiger Nau
Đánh số thứ tự trên tờ vé số (1 người xem)
Trả lời
6
Đọc
158
ptm0412
ptm0412
T
Dò giá trị nằm trong khoảng giá trị
Trả lời
1
Đọc
76
thao nguyen01
T
T
  • Question Question
Tìm dòng có mặt hàng không nằm trong danh mục bằng code VBA
Trả lời
6
Đọc
291
thao nguyen01
T
T
  • Question Question
Nhờ ACE cao thủ hỗ trợ mình có một chương trình EXCEL về phân công lớp cho giáo viên
Trả lời
5
Đọc
236
VetMini
V
V
Công thức để phân công chuyên môn cho giáo viên
Trả lời
4
Đọc
219
Hoàng Tuấn 868
H
A
HỖ TRỢ SỬA LỖI FILE EXCEL
Trả lời
4
Đọc
188
acmen87
A
V
  • Question Question
Nhờ mọi người giúp cách xóa các mục đã chọn trong Droplist của một nhóm các ô cùng dạy một môn học.
Trả lời
1
Đọc
134
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

Thời gian đếm ngược.

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