1. Trang chủ
  2. » Công Nghệ Thông Tin

LẬP TRINH VISUAL TReN EXCEL

145 217 0

Đang tải... (xem toàn văn)

Tài liệu hạn chế xem trước, để xem đầy đủ mời bạn chọn Tải xuống

THÔNG TIN TÀI LIỆU

Thông tin cơ bản

Định dạng
Số trang 145
Dung lượng 25,81 MB
File đính kèm LẬP TRINH VISUAL TReN EXCEL.rar (18 MB)

Nội dung

MỤC LỤC 1 Bài 1: MARCRO trang 2 2 Bài 2: Biến – Kiểu dữ liệu trang 8 3Bài 3: Lệnh điều kiện (Conditional Statements) trang 9 4Bài 4: Lệnh vòng lặp (Loop Statements trang 18 5Bài 5: Mảng (Array) THỰC HÀNH TRÊN FILE HAMSO2.XLMS Private Sub CommandButton1_Click() row_number = 0 dem_kytu = 0 KYTU = Sheets(sheet1).Range(F3) Do DoEvents row_number = row_number + 1 CHU = Sheets(sheet1).Range(A row_number) If InStr(CHU, KYTU) > 0 Then dem_kytu = dem_kytu + 1 End If Loop Until CHU = MsgBox so ky tu xuat hien : dem_kytu lan End Sub

MỤC LỤC 1- Bài 1: MARCRO 2- Bài 2: Biến – Kiểu liệu 3-Bài 3: Lệnh điều kiện (Conditional Statements) 4-Bài 4: Lệnh vòng lặp (Loop Statements 5-Bài 5: Mảng (Array) trang trang trang trang 18 trang 25 -Workbooks(“Seles.xls”).Worksheets(“Sheet1” ).Range(“B3”) - Bạn dùng ngoặc vng [ ] để chọn vùng thay () So sánh với ví dụ sau: [A1:A3].Select cách chọn vùng giống Range(“A1:A3”).Select thay input - output – inventory : nhập - xuất - tồn Dim lastColumn As Integer lastColumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column MsgBox lastColumn -Sub TimKiem_Trich_loc_MoTieuKien() ' Xoa ket qua tim kiem truoc ' tim kiem cac dong thoa man dieu kien va copy qua sheet REPORT Dim Datasheet As Worksheet Dim reportsheet As Worksheet Dim chonlua As String Dim lr As Long ' Gan cac bien Set Datasheet = Sheet1 Set reportsheet = Sheet4 chonlua = reportsheet.Range("B2").Value ' clear ( xoa ) du lieu cu reportsheet.Range("A5:L200").ClearContents ' quay ve Datasheet ( sheet1hay N) va Tim kiem va Copy Datasheet.Select lr = Cells(Rows.Count, 1).End(xlUp).Row ' vong lap for tim kiem For i = To lr If (Cells(i, 2) Like chonlua & "*") Then Range(Cells(i, 1), Cells(i, 12)).Copy reportsheet.Select Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats Datasheet.Select ' Tro lai sheet1 (N1) tim kiem End If Next i reportsheet.Select Range("b2").Select End Sub -EndR = Sheets("Thu").[B65536].End(xlUp).Row If EndR > 11 Then DataThu = Sheets("Thu").Range("A12:D" & EndR).Value End If … With Sheets("test") With Range(.[c1], [A65536].End(xlUp)).Offset(1) ClearContents ' Style = "EraseBorders" End With End With -Sub GotoEndRow() Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range ' The variable KeyCells contains the cells that will ' cause an alert when they are changed Set KeyCells = Range("A1:C10") If Not Application.Intersect(KeyCells, Range(Target.Address)) _ Is Nothing Then ' Display a message when one of the designated cells has been ' changed ' Place your code here MsgBox "Cell " & Target.Address & " has changed." End If End Sub Returns a Range object that represents all the columns on the specified worksheet Syntax expression Columns expression A variable that represents a worksheet object Remarks Using the Columns property without an object qualifier is equivalent to using ActiveSheet.Columns If the active document isn't a worksheet, the Columns property fails To return a single column, include an index in parentheses For example, Columns(1) and Columns("A")return the first column Example This example formats the font of column one (column A) on Sheet1 as bold VBCopy Worksheets("Sheet1").Columns(1).Font.Bold = True Bài : MACRO 1-giới thiệu MACRO :Macro thành phần ngôn ngữ VBA, tạo để ngôn ngữ Excel thực theo yêu cầu câu lệnh chứa để hồn thành cơng việc Excel Excel ghi lại tồn bơ cơng việc mà ta thực bảng tính cách thể qua ngơn ngữ VBA dòng code Chúng ta ghi lại số cơng việc, sau xem lại số mã lệnh ghi tìm hiểu chức làm việc chúng Đối với Excel 13 ta bât Ribbon Devoloper lên cách Customize ribbon-> clich chọn vào Developer 10 Lúc excel xuất thẻ Developer Khi nhấn thẻ Developer ta có Thẻ Record Macro/stop Macro Và thẻ Use Relative Reference : sử dụng tham chiếu tường đối (quan hệ với vị trí kích hoạt ban đầu ) Macro security : Tùy chọn bảo mật macro ( cho phép chạy hay không ) Để thiếp lập chế độ Enable cho Macro ta thao tác sau : Để vào cửa sổ soan thảo Lập trinh ( viết code ) ta có cách lựa chọn thứ nhấp vào cửa sổ Visual Basic nhấn phím tắt Alt+F11 Visual Basic(Alt+F11 ) : cửa sổ soạn thảo VBA -GHI MACRO BẰNG RECORD MACRO, THỰC HIỆN MACRO 3-THỰC HIỆN(RUN) MACRO ĐÃ TẠO Cách : Thực từ bảng điều khiển Chọn Marco (Alt+F8) từ Ribbon Developer Chọn Macro cần thực nhấn phím Run Cách : Thực từ phím tắt Bấm tổ hợp phím tắt đặt cho Macro để chạy Macro Cách : Thực cách Gán Macro vào đối tượng Đối tượng đối tượng Insert (ảnh , hình vẽ …) Hoặc đối tượng DATA FORM ảnh , hình vẽ : NHẤP chuột phải vào hình ảnh, hình vẽ TẠO COMBOBOX : TA tiên hành từ 1->7 LẬP TRINH VISUAL TRN EXCEL HÀM NGƯỜI DÙNG (USER FUNCTIONS) CÁCH BIÊN SOẠN VÀ SỬ DỤNG Ta tạo cách đưa biểu thức dùng mã lệnh Visual Basic Visual Basic Modul Hàm biên soạn cửa sổ modul theo mẫu : Public Function TênHàm(danh sách đối số ) Các câu lệnh để tính trị cho hàm End function 1)Nếu bảng tính có Modul sheet ,thì gọi lệnh tools –Marco-Visual basic Editor -vào insert chọn Module insert –procedure Ví dụ viết chươn trình tính diện tích hình tam giác public Function TAMGIAC(A, B, C) If A > B + C Or B > C + A Or C > A + B Then TAMGIAC = Else P = (A + B + C) / TAMGIAC = Sqr(P * (P - B) * (P - A) * (P - C)) End If End Function Muốn thử chương trình có chạy hay khơng ta có Ctrl-G Sau cửa sổ ta gõ ?tên chương trình đối số Ví dụ ? TAMGIAC(3,4,5) Lưu tên file lại ,kể từ bạn mở file cảnh giác bạn bảng tính chứa Macro , mà Marco chứa Virus ,do Excel gợi ý sẵn Disable Marco, bạn phải chọn Enable Macro hàm tự biên hoạt động PHONG CẤP CHO HÀM Sau viết xong ,ta lưu bảng tính vào thư mục định C:\Program Files\Microsoft Office\OFFICE11\Library Mục save as type chọn Microsoft Excel Add-In Mục file name gõ tên tập tin ví dụ MyUser Các hàm phong cấp từ hàm cục sang thành hàm toàn cục (global user functions ) -Gọi lệnh tools-Add-In ( Để Add-Ins Excel 2007 vào Office, Excel Options, Add-Ins, Go Browse chọn Add-Ins cần bổ sung vào Excel.) Nhấp chọn MyUser-Ok -Sử dụng user defined User -Insert-functionchọn user defined Function : Hàm tập hợp câu lệnh để thực chức Ví dụ: Viết hàm đơn giản VBA Bước 1: Mở cửa sổ VBA Bước 2: Thêm hàm có tên Hello Bước 3: Gõ vào dòng lệnh sau: MsgBox ("Chao ban, day chuong trinh VBA dau tien cua toi!!!") Khi cửa sổ VBA, bạn thấy kết sau: Bước 4: Kiểm tra (test) chức hàm Hello Quay lại Excel, ô b ất kỳ, gõ vào công thức sau: =Hello() Bài 2: Biến – Kiểu liệu Biến (variable) vùng nhớ dùng để lưu trữ giá trị có tính tạm thời Trước sử dụng biến, ta phải khai báo biến 1) Cách khai báo biến Dim As [, As ]… - tên biến : phải bắt đầu ký tự, dài tối đa 255 ký tự, khoảng trắng dấu chấm - kiểu (data type) : có nh ững kiểu sau: Loại Tên kiểu Số byte Miền giá trị Byte integer Long Single 4 Số thực Double Logic Boolean Số nguy ên to 255 [–32,768, 32,767] [–2,147,483,648, 2,147,483,647] Số âm: –3.402823E38 to –1.401298E–45 Số dương: 1.401298E–45 to 3.402823E38 Số âm: –1.79769313486232E308 –4.94065645841247E–324 Số dương: 4.94065645841247E–324 1.79769313486232E308 True, False Ngày, Chuỗi Date String ký tự Char 01/01/100 to 31/12/9999 Từ đến khoảng tỷ ký tự Ví dụ 1: Dim diem As Single, phai As Boolean, as Date Dim ten As String Chú ý: Bật chế độ bắt buộc phải khai báo biến trước dùng: cửa sổ VBA, click menu Tools => Options, chọn Require Variable Declaration 2) Các phép toán - Cộng, trừ, nhân, chia : +, –, *, / - Lũy th ừa : ^ VD: 6^2 -> 36 - Trả số dư phép chia: mod VD: 14 mod -> - Trả thương số phép chia: \ VD: 14 \ -> - Nối nhiều chuỗi: & VD: “abc” & “456” & “xyz” -> “abc456xyz” 3) Phép gán Dùng để thay đổi giá trị biến Cú pháp sau: = Ví dụ 2: ten = “Visual Basic” phai = True = #10/18/2011# diem = 6.5 diem = diem + 0.5 x = y^2 + (z mod y) Ví dụ 3: viết hàm trả thương số phép chia Public Function ThuongSo(SoBiChia As Integer, SoChia As Integer) ThuongSo = SoBiChia \ SoChia End Function Chú ý: - Khai báo tham số (argument / parameter): As Bài tập 1) Viết hàm trả số dư phép chia 2) Viết hàm nhận vào số ngun có chữ số, tính tổng tích chữ số 3) Viết hàm nhận vào số tiền nguy ên, đổi số tiền thành tờ 500, 20, dư 4) Viết hàm nhận vào thời gian tính theo giây, đổi sang dạng giờ:phút:giây (Gợi ý: 2, 3, ta trả chuỗi) Giải Bt1 Public Function Duso(SoBiChia As Integer, SoChia As Integer) Duso = SoBiChia Mod SoChia End Function Bt2 Public Function TongTich(So As Integer) Dim tram As Integer, chuc As Integer, donvi As Integer TongTich = "" tram = So \ 100 chuc = (So \ 10) Mod 10 donvi = So Mod 10 TongTich = "Tong cac chu so la " & (tram + chuc + donvi)&chr(13) TongTich = TongTich & ", Tich cac chu so la " & (tram * chuc * donvi) End Function Bt3 iChi = iChi + ‘ tang số ichi tức tăng số hàng SHEET CHI Else DataSoQuy(iSoQuy, 1) = DataThu(iThu, 2) DataSoQuy(iSoQuy, 2) = DataThu(iThu, 1) DataSoQuy(iSoQuy, 4) = DataThu(iThu, 3) DataSoQuy(iSoQuy, 5) = DataThu(iThu, 4) TonQuy = TonQuy + DataThu(iThu, 4) DataSoQuy(iSoQuy, 7) = TonQuy iThu = iThu + End If Loop Do Until iThu > UBound(DataThu, 1) iSoQuy = iSoQuy + DataSoQuy(iSoQuy, 1) = DataThu(iThu, 2) DataSoQuy(iSoQuy, 2) = DataThu(iThu, 1) DataSoQuy(iSoQuy, 4) = DataThu(iThu, 3) DataSoQuy(iSoQuy, 5) = DataThu(iThu, 4) TonQuy = TonQuy + DataThu(iThu, 4) DataSoQuy(iSoQuy, 7) = TonQuy iThu = iThu + Loop Do Until iChi > UBound(DataChi, 1) iSoQuy = iSoQuy + DataSoQuy(iSoQuy, 1) = DataChi(iChi, 2) DataSoQuy(iSoQuy, 3) = DataChi(iChi, 1) DataSoQuy(iSoQuy, 4) = DataChi(iChi, 3) DataSoQuy(iSoQuy, 6) = DataChi(iChi, 4) TonQuy = TonQuy - DataChi(iChi, 4) DataSoQuy(iSoQuy, 7) = TonQuy iChi = iChi + Loop With Sheets("SoQuy") With Range(.[H13], [A65536].End(xlUp)).Offset(1) ClearContents Style = "EraseBorders" End With [A14:G14].Resize(iSoQuy).Value = DataSoQuy [A14:H14].Resize(iSoQuy).Style = "DrawBorders" With Cells(iSoQuy + 14, 1) Value = "Céng" Offset(, 4).Resize(, 2).FormulaR1C1 = "=SUM(R14C:R[-1]C)" Offset(, 6).FormulaR1C1 = "=R8C2+RC[-2]-RC[-1]" Resize(, 8).Style = "TotalRow" End With [B9].Formula = "=E" & iSoQuy + 14 [B10].Formula = "=F" & iSoQuy + 14 End With End Sub -ví dụ mảng Sub FillArray5() Dim Data() As Variant Dim ValidRow, r, LRow As Integer Sheets("sheet4").Select 'LRow = Range("A1").End(xlUp).Row '151 total rows LRow = Sheets("Sheet4").[B65536].End(xlUp).Row Erase Data() With Sheets("test") With Range(.[c1], [A65536].End(xlUp)).Offset(1) ClearContents ' Style = "EraseBorders" End With End With For r = To LRow If Cells(r, 3).Value "Bridge From" And Cells(r, 3).Value "Bridge To" _ And Cells(r, 3).Value "" Then ValidRow = ValidRow + ReDim Preserve Data(1 To LRow, To 2) Data(ValidRow, 1) = Range("A" & r).Value 'fills the array with col A Data(ValidRow, 2) = Range("B" & r).Value 'fills the array with col B End If Next r ActiveWorkbook.Worksheets("Test").Range("A2:B" & ValidRow + 1) = Data() 'assign after and assessed it End Sub loop has run through all data SMALL (Hàm SMALL) Áp dụng Cho: Excel for Office 365 Excel for Office 365 for Mac Excel 2016 Excel 2013 Bài viết mô tả cú pháp công thức cách dùng hàm SMALL Microsoft Excel Mô tả Trả giá trị nhỏ thứ k tập liệu Dùng hàm để trả giá trị với thứ hạng tương đối cụ thể tập liệu Cú pháp SMALL(array,k) Cú pháp hàm SMALL có đối số sau đây: • Array k • K Bắt buộc Mảng phạm vi liệu dạng số mà bạn muốn xác định giá trị nhỏ thứ Bắt buộc Vị trí (từ giá trị nhỏ nhất) mảng phạm vi liệu cần trả Chú thích • Nếu mảng trống, hàm SMALL trả giá trị lỗi #NUM! • Nếu k ≤ k vượt số điểm liệu, hàm SMALL trả giá trị lỗi #NUM! • Nếu n số điểm liệu mảng, hàm SMALL(array,1) bằng với giá trị nhỏ hàm SMALL(array,n) bằng với giá trị lớn Ví dụ Sao chép liệu ví dụ bảng sau dán vào A1 bảng tính Excel Để cơng thức hiển thị kết quả, chọn chúng, nhấn F2 sau nhấn Enter Nếu cần, bạn điều chỉnh độ rộng cột để xem tất liệu Dữ liệu Dữ liệu 4 3 12 54 23 Công thức Mô tả (Kết quả) Kết quả =SMALL(A2:A10,4) Số nhỏ thứ cột (4) =SMALL(B2:B10,2) Số nhỏ thứ cột thứ hai (3) HT=IF(Nhaplieu!$B$11:$B$1927=P.Xuatkho!$F$7,ROW(Nhaplieu!$B$11:$B$1927)-9," ") =IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1926,SMALL(HT,ROW($A1)),5)," ") HT=IF(Nhaplieu!$B$11:$B$1927=P.Xuatkho!$F$7,ROW(Nhaplieu!$B$11:$B$1927)-9," ") Dim Datasheet As Worksheet Dim reportsheet As Worksheet Dim chonlua As String Dim lr As Long ' Gan cac bien Set Datasheet = Sheet2 Set reportsheet = Sheet3 Datasheet.Select lr = Cells(Rows.Count, 2).End(xlUp).Row ' vong lap for tim kiem For i = To lr If (Cells(i, 2) Like chonlua & "*") Then Range(Cells(i, 1), Cells(i, 12)).Copy reportsheet.Select Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats Datasheet.Select ' Tro lai sheet1 (N1) tim kiem End If Next i reportsheet.Select Range("b2").Select Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range, r As Range, lr As Long lr = Sheets("Sheet2").[B65536].End(xlUp).Row Set rng = Intersect(Target, Range("b2:b" & lr)) If rng Is Nothing Then Exit Sub Sheet2.select For i = To lr I f Not IsEmpty(cells(i,2).Value) Then Range(Cells(i, 2), Cells(i, 4)).Copy Sheet3.Select Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats Sheet2.Select ' Tro lai sheet1 (N1) tim kiem Endif Next i Set rng = Nothing End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range, r As Range, lr As Long lr = Sheets("Sheet2").[B65536].End(xlUp).Row Set rng = Intersect(Target, Range("b2:b" & lr)) If rng Is Nothing Then Exit Sub For Each r In rng If Not IsEmpty(r.Value) Then r.Copy Destination:=Sheets("sheet3").Range("a2:a" & lr) End If Next Set rng = Nothing End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range, r As Range, lr As Long lr = Sheets("Sheet2").[B65536].End(xlUp).Row Set rng = Intersect(Target, Range("b2:b" & lr)) If rng Is Nothing Then Exit Sub CALL GTNHAP(TARGET) Set rng = Nothing End Sub Sử dụng hàm VLOOKUP using VBA Function GTTON(kytu As String) As Double Dim ws As Worksheet, wr As Worksheet, Tondau As Double Set myrange = Sheets("ton").Range("C:E") Tondau = Application.WorksheetFunction.VLookup(kytu, myrange, 3, False) Call GTNHAP(kytu) Call GTXUAT(kytu) GT = Tondau + GTNHAP(kytu) - GTXUAT(kytu) GTTON = GT End Function Tính giá tri Nhập Function GTNHAP(kytu As String) As Double Dim ws As Worksheet, wr As Worksheet Dim dbDate As Double, db2Date As Double Dim i As Long Dim GT As Double GT = For Each ws In Sheets If (ws.Name = "N1") Or (ws.Name = "N2") Then ws.Select lr = ws.Range("B" & Rows.Count).End(xlUp).Row For i = 12 To lr CHU = ws.Range("C" & i) If (InStr(CHU, kytu) > 0) Then GT = GT + ws.Range("N" & i) End If Next i End If Next ws GTNHAP = GT End Function Tính giá tri xuất Function GTXUAT(kytu As String) As Double Dim ws As Worksheet, wr As Worksheet Dim dbDate As Double, db2Date As Double Dim i As Long Dim GT As Double GT = For Each ws In Sheets If (ws.Name = "X1") Or (ws.Name = "X2") Then ws.Select lr = ws.Range("B" & Rows.Count).End(xlUp).Row For i = 12 To lr CHU = ws.Range("C" & i) If (InStr(CHU, kytu) > 0) Then GT = GT + ws.Range("N" & i) End If Next i End If Next ws GTXUAT = GT End Function Tính giá tri TON Sub TON_all() Dim ws As Worksheet Dim i As Long, lr As Long Set ws = Sheets("ton") ws.Select lr = ws.Range("c" & Rows.Count).End(xlUp).Row For i = To lr ws.Range("j" & i).ClearContents ws.Range("j" & i) = GTTON(ws.Range("C" & i)) Next i ws.Select End Sub Dim ws As Worksheet Dim i As Long, lr As Long Set ws = Sheets("ton") ws.Select lr = ws.Range("c" & Rows.Count).End(xlUp).Row For i = To lr ws.Range("F" & i).ClearContents ws.Range("G" & i).ClearContents ws.Range("j" & i).ClearContents ws.Range("F" & i) = GTNHAP(ws.Range("C" & i)) ws.Range("G" & i) = GTXUAT(ws.Range("C" & i)) ws.Range("j" & i) = GTTON(ws.Range("C" & i)) Next i ws.Select tham Chiếu Trong Excel (3) Kiểu tham chiếu R1C1 Ngồi chuyển kiểu tham chiếu từ dạng A1 sang dạng R1C1, kiểu tham chiếu R1C1 hữu ích cho việc tính tốn vị trí dòng cột VBA Đối với kiểu R1C1, Excel ký hiệu “R” để dòng theo sau số thứ tự dòng ký hiệu "C" để cột theo sau số thứ tự cột • • • • • R: dòng C: cột Chỉ số sau R hay C để móc vng [ ] tham chiếu tương đối Chỉ số sau R hay C không để móc vng [ ] tham chiếu tuyệt đối R (chính R[0]) hay C (chính C[0]) khơng có số theo sau biểu thị dòng hay cột với ô hành Tạo NXT Tao VT= MAHANG=DanhMuc!B9, TEN HANG=DanhMuc!C9, DVT =DanhMuc!D9, Ton dk =DanhMuc!E9 nhaptk =SUMIF(tbl_NhapLieu[4],NXT!A11,tbl_NhapLieu[7]) xuat tk =SUMIF(tbl_NhapLieu[4],NXT!A11,tbl_NhapLieu[8]) tonck= =[@4]+[@5]-[@6] =SUMIF(tbl_Nhaplieu[4],'NXT'!A11,tbl_Nhaplieu[7]) Tao Sub Update_NXT() để Update liệu từ thay đổi Dữ liệu từ sheet NHAPlIEU, Sub Update_NXT() Dim oList As ListObject, rHeader As Range, iCount As Long Dim vung As String, iCol As Integer Set oList = ActiveWorkbook.Sheets("NXT").ListObjects("tbl_NXT") Set rHeader = oList.ListColumns(1).Range(1) iCount = Range("tbl_NXT[1]").Count 'dem' lan` If iCount > Then rHeader.Offset(2).Resize(iCount - 1).EntireRow.Delete MsgBox "xoa' Row", , "xong" End If ' vung = rHeader.Address & ":$G$" & Range("tbl_Danhmuc[1]").Count + rHeader.Row '(vung="$A$10:$G$2xxx") oList.Resize Range(vung) 'Record Macro MsgBox "chen` Row, cong thuc, Format Cells", , "xong" ' iCount = Range("tbl_NXT[1]").Count 'dem' lan` iCol = oList.Range.Columns.Count With rHeader.Offset(2).Resize(iCount - 1, iCol) Value = Value End With MsgBox "chuyen? cong thuc thanh` Value", vbInformation, "Xong" End Sub 1- Taọ vùng array VT gồm =IF(Nhaplieu!$D$11:$D$1927=Sochitiet!$D$8,ROW(Nhaplieu!$D$11:$D$1927)-9,"") 2-TẠO sochitietFirstrow va SoChiTietLastRow Vid Sochitiet!SD$8 Sochitiet_FirstRow= Sochitiet!$A$13 Sochitiet_LastRow=Sochitiet!$A$16 Tên vt=VLOOKUP(D8,Danhmuc!$B$9:$C$2036,2,0) =IF(COUNT(VT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$H$1926,SMALL(VT,ROW($A1)),2),"") SDDK =VLOOKUP(D8,tbl_Danhmuc[[2]:[5]],4,0) GHI CHU Xuất dự án =IF(COUNT(VT)>=ROW($A1),INDEX(Nhaplieu! $A$11:$I$1926,SMALL(VT,ROW($A1)),9),"") 3-tai sheet Sochitiet Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$8" Then If Target "" Then Call UpdateSoChiTiet(Target) End If End Sub Sub UDSCT() 'Sub UpDateSCT(rng1 As Range, rng2 As Range, Vung As Range) Dim rng1 As Range, rng2 As Range, rng4 As Range, LastCol As String Set rng1 = Range("Sochitietvd_FirstRow") Set rng2 = Range("Sochitietvd_LastRow") Set rng3 = Range("tbl_Nhaplieu[4]") ' Set rng4 = rTarget LastCol = "H" Dim x As Long, y As Long, wsFunc As WorksheetFunction, MyCountif As Long, vung As Range Dim rTarget As Range Set vung = Range("tbl_Nhaplieu[4]") Set rTarget = Range("$D$8") x = rng1.Row y = rng2.Row Set wsFunc = Application.WorksheetFunction MyCountif = wsFunc.CountIf(vung, rTarget.Value) If x - y Then ' neu Hang dau va hang cuoi cach hon dong Range("A" & x).Offset(1).Resize(y - x - 1).EntireRow.Delete y = rng2.Row End If If MyCountif = Or MyCountif = Then Exit Sub ' chi xoa Row , khong then row Range("A" & y).Resize(MyCountif - 1).EntireRow.Insert Set vung = Range("A" & x, LastCol & x) vung.AutoFill Destination:=vung.Resize(MyCountif), Type:=xlFillDefault With Sheets("SoChiTiet ") With Cells( Mycountif+ 13, 5) Resize(, 2).FormulaR1C1 = "=SUM(R13C:R[-1]C)" Offset(,2).FormulaR1C1 = "=R12C4+RC[-2]-RC[-1]" End With End With With Range("C" & x).Resize(MyCountif) '3 sheet deu chung cot C WrapText = False WrapText = True End With End Sub -Tai sheet SochiTiet Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$8" Then If Target "" Then Call UpdateSoChiTiet(Target) End If End Sub -Sub UpdateSoChiTiet(rTarget As Range) Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, sCol As String Set rng1 = Range("Sochitiet_FirstRow") Set rng2 = Range("Sochitiet_LastRow") Set rng3 = Range("tbl_Nhaplieu[4]") Set rng4 = rTarget sCol = "H" Call UpdateSheet(rng1, rng2, rng3, rng4, sCol) End Sub Tao sub ub UpdateSheet1(xRng As Range, yRng As Range, vung As Range, rTarget As Range, LastCol As String) Dim x As Long, y As Long, wsFunc As WorksheetFunction, MyCountif As Long, t As Long x = xRng.Row y = yRng.Row Set wsFunc = Application.WorksheetFunction MyCountif = wsFunc.CountIf(vung, rTarget.Value) t = MyCountif If y - x Then Range("A" & x).Offset(1).Resize(y - x - 1).EntireRow.Delete y = yRng.Row 'xac dinh lan` End If If MyCountif = Or MyCountif = Then Exit Sub 'chi xoa' Row, ko them Row Range("A" & y).Resize(MyCountif - 1).EntireRow.Insert ' - AutoFill(Record Macro) Set vung = Range("A" & x, LastCol & x) vung.AutoFill Destination:=vung.Resize(MyCountif), Type:=xlFillDefault ' With Sheets("SoChiTiet") With Cells(MyCountif + 13, 5) Resize(, 2).FormulaR1C1 = "=SUM(R13C:R[-1]C)" Offset(, 2).FormulaR1C1 = "=R12C4+RC[-2]-RC[-1]" Offset(, -1).Value = "Tong Cong" End With End With With Range("C" & x).Resize(MyCountif) '3 sheet deu chung cot C WrapText = False WrapText = True End With End SubEnd SubSub UpdateSoChiTiet(rTarget As Range) Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, sCol As String Set rng1 = Range("Sochitiet_FirstRow") Set rng2 = Range("Sochitiet_LastRow") Set rng3 = Range("tbl_Nhaplieu[4]") Set rng4 = rTarget sCol = "H" Call UpdateSheet(rng1, rng2, rng3, rng4, sCol) End Sub -Tao sheet PHIEU NHAP KHO Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$F$7" Then If Target "" Then Call UpdatePNhapkho(Target) End If End Sub -Sub UpdatePNhapkho(rTarget As Range) Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, sCol As String Set rng1 = Range("PNK_FirstRow") Set rng2 = Range("PNK_LastRow") Set rng3 = Range("tbl_Nhaplieu[2]") Set rng4 = rTarget sCol = "G" Call UpdateSheet(rng1, rng2, rng3, rng4, sCol) End Sub Dim x As Long, y As Long, wsFunc As WorksheetFunction, MyCountif As Long x = xRng.Row y = yRng.Row Set wsFunc = Application.WorksheetFunction MyCountif = wsFunc.CountIf(vung, rTarget.Value) If y - x Then Range("A" & x).Offset(1).Resize(y - x - 1).EntireRow.Delete y = yRng.Row 'xac dinh lan` End If If MyCountif = Or MyCountif = Then Exit Sub 'chi xoa' Row, ko them Row Range("A" & y).Resize(MyCountif - 1).EntireRow.Insert ' - AutoFill(Record Macro) Set vung = Range("A" & x, LastCol & x) vung.AutoFill Destination:=vung.Resize(MyCountif), Type:=xlFillDefault ' With Range("C" & x).Resize(MyCountif) '3 sheet deu chung cot C WrapText = False WrapText = True End With End Sub -Tao PNK_FirstRow PNK_LastRow  Tao  KCS0570714 HT=IF(Nhaplieu!$B$11:$B$1927=P.Nhapkho!$F$7,ROW(Nhaplieu!$B$11:$B$1927)-9," ") Ngay ct=IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1929,SMALL(HT,ROW($A1)),1)," ") So isue=VLOOKUP(F7,Nhaplieu!$B$11:$J$1929,9,0) Noi dung=VLOOKUP(F7,Nhaplieu!$B$11:$J$1929,9,0) Stt =IF(B14" ",ROW()-13," ") mavt=IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1929,SMALL(HT,ROW($A1)),4)," ") tenvt=IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1929,SMALL(HT,ROW($A1)),5)," ") dvt=IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1929,SMALL(HT,ROW($A1)),6)," ") soluong =IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1929,SMALL(HT,ROW($A1)),7)," ") Nhap lieu=COUNTIF(tbl_Nhaplieu[2],F7) p nhapkho=COUNTA(A14:A19) KCS0570714 Phiếu xuất kho Vi dụ với MAVT : PXK006/0614PI PXK_FirstRow= P.Xuatkho!$A$14 PXK_LastRow= =P.XuatKho!$A$22 - Tạo vùng array XK - XK =IF(Nhaplieu!$B$11:$B$1927=P.Xuatkho!$F$7,ROW(Nhaplieu!$B$11:$B$1927)-9," ") PXK001/0614PI PXK006/0614PI PXK008/0614PI PXK009/0614PI PXK004/0614PI PXK020/0614PI PXK020/0614PI Ngày chứng từ =IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1927,SMALL(HT,ROW($A1)),1)," ") STT=IF(B14" ",ROW()-13," ") MAVT=IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1927,SMALL(HT,ROW($A1)),4)," ") TEN VT =IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1926,SMALL(HT,ROW($A1)),5)," ") DIENGIAI =IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1926,SMALL(HT,ROW($A1)),5)," ") DVT =IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1926,SMALL(HT,ROW($A1)),6)," ") SL=IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1926,SMALL(HT,ROW($A1)),8)," ") E22= =SUM(E14:E14) Nhập liệu I9= =COUNTIF(tbl_NhapLieu[2],F7) p.NHAPKHO I11=COUNTA(A14:A22) Nội dung:=VLOOKUP(F7,tbl_NhapLieu[[2]:[5]],2,0) Tai sheet Pxuatkho Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$F$7" Then If Target "" Then Call UpdatePXuatkho(Target) End If End Sub Sub UpdatePXuatkho(rTarget As Range) Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, sCol As String Set rng1 = Range("PXK_FirstRow") Set rng2 = Range("PXK_LastRow") Set rng3 = Range("tbl_Nhaplieu[2]") Set rng4 = rTarget sCol = "G" Call UpdateSheet(rng1, rng2, rng3, rng4, sCol) End Sub Sub UpdateSheet(xRng As Range, yRng As Range, vung As Range, rTarget As Range, LastCol As String) Dim x As Long, y As Long, wsFunc As WorksheetFunction, MyCountif As Long x = xRng.Row y = yRng.Row Set wsFunc = Application.WorksheetFunction MyCountif = wsFunc.CountIf(vung, rTarget.Value) If y - x Then Range("A" & x).Offset(1).Resize(y - x - 1).EntireRow.Delete y = yRng.Row 'xac dinh lan` End If If MyCountif = Or MyCountif = Then Exit Sub 'chi xoa' Row, ko them Row Range("A" & y).Resize(MyCountif - 1).EntireRow.Insert ' - AutoFill(Record Macro) Set vung = Range("A" & x, LastCol & x) vung.AutoFill Destination:=vung.Resize(MyCountif), Type:=xlFillDefault ' With Range("C" & x).Resize(MyCountif) '3 sheet deu chung cot C WrapText = False WrapText = True End With End Sub -Sheet P.Nhapkho =IF(B14" ",ROW()-13," ") Ngày ct=IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1926,SMALL(HT,ROW($A1)),1)," ") (2)=IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1926,SMALL(HT,ROW($A1)),4)," ") Số chứng từ: KCS0020614 Ngày chứng từ:=IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1926,SMALL(HT,ROW($A1)),1)," ") Stt =IF(B14" ",ROW()-13," ") mavt=IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1926,SMALL(HT,ROW($A1)),4)," ") tenvt=IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1926,SMALL(HT,ROW($A1)),5)," ") Số issue =VLOOKUP(F7,Nhaplieu!$b$11:$J$1927,9,0) Tạo mảng HT HT= =IF(NhapLieu!$B$10:$B$1927=P.NhapKho!$F$7,ROW(NhapLieu!$B$10:$B$1927)-9," ") Tao table tbl_nhaplieu= Nhaplieu!$A$11:$j$1927 Tai SHEET P.NHAPKHO Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$F$7" Then If Target "" Then Call UpdatePNhapkho(Target) End If End Sub -Sub UpdatePNhapkho(rTarget As Range) Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, sCol As String Set rng1 = Range("PNK_FirstRow") Set rng2 = Range("PNK_LastRow") Set rng3 = Range("tbl_Nhaplieu[2]") Set rng4 = rTarget sCol = "G" Call UpdateSheet(rng1, rng2, rng3, rng4, sCol) End Sub -Sub UpdateSheet(xRng As Range, yRng As Range, vung As Range, rTarget As Range, LastCol As String) Dim x As Long, y As Long, wsFunc As WorksheetFunction, MyCountif As Long x = xRng.Row y = yRng.Row Set wsFunc = Application.WorksheetFunction MyCountif = wsFunc.CountIf(vung, rTarget.Value) If y - x Then Range("A" & x).Offset(1).Resize(y - x - 1).EntireRow.Delete y = yRng.Row 'xac dinh lan` End If If MyCountif = Or MyCountif = Then Exit Sub 'chi xoa' Row, ko them Row Range("A" & y).Resize(MyCountif - 1).EntireRow.Insert ' - AutoFill(Record Macro) Set vung = Range("A" & x, LastCol & x) vung.AutoFill Destination:=vung.Resize(MyCountif), Type:=xlFillDefault ' With Range("C" & x).Resize(MyCountif) '3 sheet deu chung cot C WrapText = False WrapText = True End With End Sub KCS0270614 KCS0360614 KCS0470614 KCS0480614 PNK_FirstRow= =P.Nhapkho!$A$14 With Cells(iSoQuy + 14, 1) Value = "Céng" Offset(, 4).Resize(, 2).FormulaR1C1 = "=SUM(R14C:R[-1]C)" Offset(, 6).FormulaR1C1 = "=R8C2+RC[-2]-RC[-1]" Resize(, 8).Style = "TotalRow" End With [B9].Formula = "=E" & iSoQuy + 14 [B10].Formula = "=F" & iSoQuy + 14 End With Value = "Céng" Resize(, 8).Style = "TotalRow" Tao VT= VT=IF(Nhaplieu!$D$11:$D$1929=Sochitiet!$D$8,ROW(Nhaplieu!$D$11:$D$1929)-9,"") Ngay ct=IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1929,SMALL(HT,ROW($A1)),1)," ") So isue=VLOOKUP(F7,Nhaplieu!$B$11:$J$1929,9,0) Noi dung=VLOOKUP(F7,Nhaplieu!$B$11:$J$1929,9,0) Stt =IF(B14" ",ROW()-13," ") mavt=IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1929,SMALL(HT,ROW($A1)),4)," ") tenvt=IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1929,SMALL(HT,ROW($A1)),5)," ") dvt=IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1929,SMALL(HT,ROW($A1)),6)," ") soluong =IF(COUNT(HT)>=ROW($A1),INDEX(Nhaplieu!$A$11:$J$1929,SMALL(HT,ROW($A1)),7)," ") Nhap lieu=COUNTIF(tbl_Nhaplieu[2],F7) p nhapkho=COUNTA(A14:A19) - ... COMBOBOX : TA tiên hành từ 1->7 LẬP TRINH VISUAL TRN EXCEL HÀM NGƯỜI DÙNG (USER FUNCTIONS) CÁCH BIÊN SOẠN VÀ SỬ DỤNG Ta tạo cách đưa biểu thức dùng mã lệnh Visual Basic Visual Basic Modul Hàm biên... ) Để thiếp lập chế độ Enable cho Macro ta thao tác sau : Để vào cửa sổ soan thảo Lập trinh ( viết code ) ta có cách lựa chọn thứ nhấp vào cửa sổ Visual Basic nhấn phím tắt Alt+F11 Visual Basic(Alt+F11... 1-giới thiệu MACRO :Macro thành phần ngôn ngữ VBA, tạo để ngôn ngữ Excel thực theo yêu cầu câu lệnh chứa để hồn thành cơng việc Excel Excel ghi lại tồn bơ cơng việc mà ta thực bảng tính cách thể qua

Ngày đăng: 19/11/2018, 19:44

TỪ KHÓA LIÊN QUAN

w