Hỏi nhanh - Đáp nhanh về macro (dành cho các thành viên mới học lập trình) (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

tuananhya2

Thành viên mới
Tham gia
18/8/12
Bài viết
8
Được thích
0
Co ai chỉ dùm cách tạo pass marco với
 
Em mới đang tập tành thêm mấy hàm windowAPI, gặp vấn đề như sau mà em chưa biết dùng hàm API nào ,cụ thể :
* Khi ta chạy phần mềm excel.exe,--> trên màn hình sẽ hiển thị cửa sổ Excel starting , --> bây giờ nếu mình không muốn hiện cửa sổ excel starting nữa thì phải dùng hàm nào !
Em tìm trong các hàm về hiển thị cửa sổ mà không làm được !
Mong các anh giúp đỡ ! em cảm ơn ! @_@
 
Upvote 0
Em mới đang tập tành thêm mấy hàm windowAPI, gặp vấn đề như sau mà em chưa biết dùng hàm API nào ,cụ thể :
* Khi ta chạy phần mềm excel.exe,--> trên màn hình sẽ hiển thị cửa sổ Excel starting , --> bây giờ nếu mình không muốn hiện cửa sổ excel starting nữa thì phải dùng hàm nào !
Em tìm trong các hàm về hiển thị cửa sổ mà không làm được !
Mong các anh giúp đỡ ! em cảm ơn ! @_@

+-+-+-++-+-+-++-+-+-+ --> quên khuấy đi là hình như bất kỳ ứng dụng API nào cũng có .visible :
Tức là khi ta khai báo excel.Application thì visible mặc định của nó là False rồi,nên nó sẽ không hiển thị cửa sổ starting nữa @_@

Làm hôm qua loay hoay tìm mấy hàm API mãi mà không ra ^^!
 
Upvote 0
Có thể liên kết Excel với Notepad được không?

Gửi GPE!
Hiện nay Tôi có ý định tạo một đoạn "code" trong cửa sổ vba của Excel và một đoạn code để trong Notepad.
Thực ra 2 đoạn code này vẫn có thể cho vào cùng một Sub được nhưng sở dĩ tôi muốn tách ra là vì nhằm mục đích cho người dùng có thể tự do chỉnh sửa dễ dàng khi có sự thay đổi vi dụ mà không cần thiết phải truy cập vào trang lập trình trong VBA.

Nếu vậy thì đoạn code phải viết thế nào để 2 đoạn code này có mối liên kết được với nhau?

Mong nhận được sự giúp đỡ của các bạn!
Xin cảm ơn!
 
Upvote 0
Gửi GPE!
Hiện nay Tôi có ý định tạo một đoạn "code" trong cửa sổ vba của Excel và một đoạn code để trong Notepad.
Thực ra 2 đoạn code này vẫn có thể cho vào cùng một Sub được nhưng sở dĩ tôi muốn tách ra là vì nhằm mục đích cho người dùng có thể tự do chỉnh sửa dễ dàng khi có sự thay đổi vi dụ mà không cần thiết phải truy cập vào trang lập trình trong VBA.

Nếu vậy thì đoạn code phải viết thế nào để 2 đoạn code này có mối liên kết được với nhau?

Mong nhận được sự giúp đỡ của các bạn!
Xin cảm ơn!

Nói chung là: CÓ THỂ
Tuy nhiên bạn nên nói cụ thể 1 chút: Đó là những đoạn code gì? Liên kết là liên kết thế nào?
 
Upvote 0
Nói chung là: CÓ THỂ
Tuy nhiên bạn nên nói cụ thể 1 chút: Đó là những đoạn code gì? Liên kết là liên kết thế nào?
Cảm ơn Bạn đã cho ý kiến!
Về ví dụ Tôi xin phép là tạm thời lấy ví dụ đơn giản như thế này:
Mã:
Sub Macro1()
    Range("C5:F16").Copy
    Range("G5:J16").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    [COLOR=#0000ff][B]Macro2[/B][/COLOR]
End Sub

Mã:
Sub Macro2()
    Range("C5:F5").EntireColumn.Hidden = True
End Sub

Tôi muón gán Sub Macro2 vào trong file Notepad.Và Sub Macro1 vẫn để trong file Excel.
2 file này để trong cùng một thư mục.
Chi tiết Bạn có thể coi file kèm.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn Bạn đã cho ý kiến!
Về ví dụ Tôi xin phép là tạm thời lấy ví dụ đơn giản như thế này:
Mã:
Sub Macro1()
    Range("C5:F16").Copy
    Range("G5:J16").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    [COLOR=#0000ff][B]Macro2[/B][/COLOR]
End Sub

Mã:
Sub Macro2()
    Range("C5:F5").EntireColumn.Hidden = True
End Sub

Tôi muón gán Sub Macro2 vào trong file Notepad.Và Sub Macro1 vẫn để trong file Excel.
2 file này để trong cùng một thư mục.
Chi tiết Bạn có thể coi file kèm.

Bạn sửa toàn bộ code thành vầy nhé:
Mã:
[COLOR=#ff0000]Public module As Object[/COLOR]
Sub Macro1()
  [COLOR=#ff0000]On Error Resume Next[/COLOR]
  Range("C5:F16").Copy
  Range("G5:J16").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
  Application.CutCopyMode = False
  [COLOR=#ff0000]Dim txtFile As String
  txtFile = ThisWorkbook.Path & "\Test.txt"
  CreateCodeFromTextFile txtFile
  Run "Macro2"
  ThisWorkbook.VBProject.VBComponents.Remove module[/COLOR]
End Sub
[COLOR=#0000cd]Sub CreateCodeFromTextFile(ByVal txtFile As String)
  Dim strCode As String
  On Error Resume Next
  With CreateObject("Scripting.FileSystemObject")
    With .OpenTextFile(txtFile)
      strCode = .ReadAll: .Close
    End With
  End With
  strCode = Replace(strCode, vbCrLf, vbLf)
  Set module = ThisWorkbook.VBProject.VBComponents.Add(1)
  module.CodeModule.InsertLines 2, strCode
End Sub[/COLOR]
Chổ màu xanh là 1 sub mới vừa thêm vào.
Chổ màu đỏ là những chổ cần sửa trong macro1
----------------------
Ngoài lề: Tuy cách nói chuyện có khác nhưng "cách học" của bạn khiến tôi nhớ đến 1 người (mà thời gian gần đây tôi thường trợ giúp)
???
Ẹc... Ẹc...
 
Upvote 0
Bạn sửa toàn bộ code thành vầy nhé:

To NDU:
Cảm ơn Thầy đã giúp đỡ!

Ngoài lề: Tuy cách nói chuyện có khác nhưng "cách học" của bạn khiến tôi nhớ đến 1 người (mà thời gian gần đây tôi thường trợ giúp)
???
Ẹc... Ẹc...

Không ngờ ngòai khả năng vượt trội về khiến kiến thức ra thì khả năng phán đoán của Thầy cũng khiến tôi thật bất ngờ...Có thể Thầy đã đoán đúng (Có thể tôi và "người đó" là một..).
Tôi đặt trường hợp khi Thầy đã đoán đúng_Tôi xin giải thích:
Đúng là ngoài ních này ra tôi còn một nich nữa hay sử dụng nhưng tôi lại không sử dụng ních đó cho bài này vì trước khi gửi bài này tôi cũng đã nghĩ đến Thầy.
Tôi cũng hiểu phần nào về tính cách của Thầy.Cái mà tôi hiểu ở đây là Thầy luôn muốn mọi người đi từ cái cơ bản nhất rồi mới tới cái nâng cao...Nhưng đôi khi có những cái tôi cảm thấy cần thiết phải đi ngược lại vì vậy tôi mới có thêm một nich nữa...Hi vọng Thầy sẽ không trách!

Thật sự mà nói đối với Tôi,Thầy rất quan trọng và đặc biệt.

Rất cảm ơn sự chú ý và giúp đỡ của Thầy!
 
Upvote 0
=
Tôi cũng hiểu phần nào về tính cách của Thầy.Cái mà tôi hiểu ở đây là Thầy luôn muốn mọi người đi từ cái cơ bản nhất rồi mới tới cái nâng cao...Nhưng đôi khi có những cái tôi cảm thấy cần thiết phải đi ngược lại vì vậy tôi mới có thêm một nich nữa...Hi vọng Thầy sẽ không trách!

Nói đùa thôi mà
Bạn tiếp thu được, áp dụng được là tôi mừng rồi (mọi chuyện khác không quan trọng)
Ẹc... Ẹc...
------------
Nói thêm về cách vận hành của code trên cho bạn mường tượng:
- Code mở file text, copy toàn bộ chúng cho vào 1 biến tạm
- Chèn 1 Module rồi gán code trong biến tạm vào module ấy (ta có ngay Sub Macro2)
- Chạy Mạcro2
- Chạy xong, xóa luôn Module đã chèn (cho mất tích)
 
Lần chỉnh sửa cuối:
Upvote 0
Nói thêm về cách vận hành của code trên cho bạn mường tượng:
- Code mở file text, copy toàn bộ chúng cho vào 1 biến tạm
- Chèn 1 Module rồi gán code trong biến tạm vào module ấy (ta có ngay Sub Macro2)
- Chạy Mạcro2
- Chạy xong, xóa luôn Module đã chèn (cho mất tích)

Cảm ơn Thầy vì sự chu đáo!
Mới đầu Em cũng định nhờ Thầy giải thích cặn kẽ hơn.Nhưng sau một hồi vằn vọc mãi Em mới thử xóa dòng này đi xem sao:
Mã:
Sub Macro1()
  'On Error Resume Next
  Range("C5:F16").Copy
  Range("G5:J16").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
  Application.CutCopyMode = False
  Dim txtFile As String
  txtFile = ThisWorkbook.Path & "\Test.txt"
  CreateCodeFromTextFile txtFile
  Run "Macro2"
  [COLOR=#ff0000][B]‘ThisWorkbook.VBProject.VBComponents.Remove module[/B][/COLOR]
End Sub
Thì đã hiểu được thêm mục đích của code này để làm gì:
Mã:
Sub CreateCodeFromTextFile(ByVal txtFile As String)
  Dim strCode As String
  'On Error Resume Next
  With CreateObject("Scripting.FileSystemObject")
    With .OpenTextFile(txtFile)
      strCode = .ReadAll: .Close
    End With
  End With
  strCode = Replace(strCode, vbCrLf, vbLf)
  Set module = ThisWorkbook.VBProject.VBComponents.Add(1)
  module.CodeModule.InsertLines 2, strCode
End Sub
Thì mới ngộ ra được sơ qua về nguyên lý hoạt động của các code:
Mục đích của nó đó là sao chép toàn bộ thông tin trong file .txt theo đường dẫn
Mã:
ThisWorkbook.Path & "\Test.txt"
Sau đó tạo một Module mới trong cửa sổ lập trình của Excel rồi dán(thay thế) toàn bộ thông tin của file .txt vào trong Module mới tạo này.Sau đó cho chạy tên đoạn code
Mã:
 (Run "Macro2")
mà mình muốn chạy.
Cuối cùng là sử dụng “ThisWorkbook.VBProject.VBComponents.Remove module” để xóa đi cái module vừa mới tạo…
Em hiểu là như vậy.
----------
Tuy nhiên trong vấn đề này nếu file đặt passvba thì không thể thực hiện được như yêu cầu trên.
Thầy có cách nào khắc phục được tình trạng này không ạ? Ví dụ passvba là:123
 
Upvote 0
Tuy nhiên trong vấn đề này nếu file đặt passvba thì không thể thực hiện được như yêu cầu trên.
Thầy có cách nào khắc phục được tình trạng này không ạ? Ví dụ passvba là:123

Cái vụ PassVBA cũng mệt lắm nha (trên GPE đã bàn nhiều)
Nói chung hiện nay chưa có phương pháp nào can thiệp được 1 cách TOÀN DIỆN vào cửa sổ lập trình khi nó đã được đặt password
Người ta thường dùng SendKeys để thay thế cho thao tác bằng tay. Ví dụ:
Application.SendKeys "%{F11}" để giả lập thao tác bằng tay bấm tổ hợp phím Alt + F11 (mở cửa sổ lập trình)
Tiếp theo ta thao tác bằng tay cái gì đó để mở password thì cứ lần lượt SendKeys y chang vậy
vân vân...
Nhưng nói chung phương pháp này vừa dở ẹc vừa chẳng hiệu quả chút nào (hay bị lỗi tầm bậy tầm bạ) nên tôi cũng không khuyên dùng
Vậy nên: Tạm thời bạn đừng nghiên cứu nó cho mất công
(khi nào tìm được giải pháp khác hay hơn, tôi sẽ cho bạn biết)
 
Upvote 0
Cái vụ PassVBA cũng mệt lắm nha (trên GPE đã bàn nhiều)
Nói chung hiện nay chưa có phương pháp nào can thiệp được 1 cách TOÀN DIỆN vào cửa sổ lập trình khi nó đã được đặt password
Người ta thường dùng SendKeys để thay thế cho thao tác bằng tay. Ví dụ:
Application.SendKeys "%{F11}" để giả lập thao tác bằng tay bấm tổ hợp phím Alt + F11 (mở cửa sổ lập trình)
Tiếp theo ta thao tác bằng tay cái gì đó để mở password thì cứ lần lượt SendKeys y chang vậy
vân vân...
Nhưng nói chung phương pháp này vừa dở ẹc vừa chẳng hiệu quả chút nào (hay bị lỗi tầm bậy tầm bạ) nên tôi cũng không khuyên dùng
Vậy nên: Tạm thời bạn đừng nghiên cứu nó cho mất công
(khi nào tìm được giải pháp khác hay hơn, tôi sẽ cho bạn biết)

Cảm ơn Thầy đã chia sẻ!
Với kinh nghiệm của Thầy, thì Thầy có thể nhận ra rằng phương pháp này chưa hiệu quả lắm.
Nhưng đối với Em thì chưathể nào mà biết được cái nào hoàn hảo để mà dùng nó cả. Vì vậy cứ cái gì có khẳng năng dùng được thì ta dùng.
Chờ đến một ngày nào đó hi vọng sẽ có cái mới hoàn hảo hơn để ta thay thế cái cũ. Nhưng khoảng thời gian chờ đó cũng chưa biết thế nào.Trong thời gian này ta có thể sử dụng những cái mà phục vụ được mục đích của ta cũng được Thầy ạ!
Hơn nữa Em đang trong thời gian học hỏi để áp dụng nên kiến thức lúc này là rất cần thiết.

Lúc nào tiện Thầy có thể viết hoàn chỉnh code theo phương pháp dùng SendKeys để Em hiểu thêm và áp dụng được không ạ?
Cảm ơn Thầy!
 
Upvote 0
Cảm ơn Thầy đã chia sẻ!
Với kinh nghiệm của Thầy, thì Thầy có thể nhận ra rằng phương pháp này chưa hiệu quả lắm.
Nhưng đối với Em thì chưathể nào mà biết được cái nào hoàn hảo để mà dùng nó cả. Vì vậy cứ cái gì có khẳng năng dùng được thì ta dùng.
Chờ đến một ngày nào đó hi vọng sẽ có cái mới hoàn hảo hơn để ta thay thế cái cũ. Nhưng khoảng thời gian chờ đó cũng chưa biết thế nào.Trong thời gian này ta có thể sử dụng những cái mà phục vụ được mục đích của ta cũng được Thầy ạ!
Hơn nữa Em đang trong thời gian học hỏi để áp dụng nên kiến thức lúc này là rất cần thiết.

Lúc nào tiện Thầy có thể viết hoàn chỉnh code theo phương pháp dùng SendKeys để Em hiểu thêm và áp dụng được không ạ?
Cảm ơn Thầy!
Tức là đầu tiên bạn phải có code Unprotect VBA trước mới chạy được những thứ khác
Cái vụ Unprotect VBA đang bàn ở đây nè:
http://www.giaiphapexcel.com/forum/...ình-biết-pass)&p=519873&highlight=#post519873
 
Upvote 0
Cách sự dụng SendKeys?

Tức là đầu tiên bạn phải có code Unprotect VBA trước mới chạy được những thứ khác
Cái vụ Unprotect VBA đang bàn ở đây nè:
http://www.giaiphapexcel.com/forum/...ình-biết-pass)&p=519873&highlight=#post519873
Cảm ơn Thầy,Em sẽ tìm hiểu vấn đề trên sau.
Nhân đây xin hỏi Thầy thêm về lĩnh vực SendKeys:
Cụ thể là cách dùng và Thầy có danh sách SendKeys không ạ(vd:"%{F11}")?
 
Upvote 0
Cảm ơn Thầy,Em sẽ tìm hiểu vấn đề trên sau.
Nhân đây xin hỏi Thầy thêm về lĩnh vực SendKeys:
Cụ thể là cách dùng và Thầy có danh sách SendKeys không ạ(vd:"%{F11}")?

Trong cửa sổ lập trình, bạn gõ dòng lệnh Application.Sendkeys
Xong bôi đen chữ SendKeys rồi bấm F1 sẽ có câu trả lời đầy đủ (cả ví dụ cụ thể)
Nói chung, cái gì không biết cũng cứ làm thế nhé
 
Upvote 0
Nhờ giải thích chỗ sai của dòng code dơn giản(đang học)

Các bạn chỉ giúp mình chỗ sai, điểm không hợp lý trong dòng code của mình với
Mình dang tập nên lấy ví dụ đơn giản ban vo giúp với
Thank!
 

File đính kèm

Upvote 0
Sửa code thì tôi chưa test kỹ, nhưng nếu muốn hoán vị thì có những thủ thuật gọn hơn:

1) Dùng hàm để hoán vị:

Mã:
Sub Chuyen2()
    'Dung ham hoan vi:
    With Worksheets("sheet1")
        .Range("C2:U2") = WorksheetFunction.Transpose(.Range("A2:A20"))
    End With
End Sub

2) Dùng copy paste để hoán vị:


Mã:
Sub Chuyen3()
    'Copy roi paste hoan vi:
    With Worksheets("sheet1")
        .Range("A2:A20").Copy
        .Range("C2").PasteSpecial Paste:=xlPasteValues, Transpose:=True
    End With
End Sub
 
Upvote 0
Bây giờ mới test code của bạn nè:

1) Nó báo lỗi dòng đó là vì lỗi tràn dòng, nhưng thực chất lỗi không phát sinh tại đó mà lỗi do biến n tạo ra.

Bạn đặt biến n = Worksheets("sheet1").Range("A2:A20").Row

Với giá trị này, dù cho từ A2 đến A10000000 đi chăng nữa nó vẫn chỉ là bằng 2 mà thôi, với Row nó chỉ lấy dòng đầu tiên.

Vậy thì ta đặt biến cho nó thay vì .Row thì ta thay bằng .Rows.Count tức tổng số hàng mà nó đếm được trong vùng tham chiếu.

2) Sau khi tạo mảng 1 chiều rồi thì không cần thêm 1 vòng lặp nữa (tuy không sai nhưng hao tốn thời gian và dung lượng bộ nhớ), chỉ chọn vùng tương ứng bằng mảng là được.


Sau đây là code tôi đã chỉnh sửa lại cho bạn:

Mã:
Sub Chuyen1()
    Dim n As Long, m As Long, mang() As Long, ran1 As Range
    n = Worksheets("sheet1").Range("A2:A20").Rows.Count
    ReDim mang(1 To n)
    For Each ran1 In Worksheets("sheet1").Range("A2:A20")
        m = m + 1
        mang(m) = ran1.Value
    Next
    Worksheets("sheet1").Range("C2:U2") = mang
End Sub

Ngoài ra còn một cách nữa, tôi nghĩ là tốc độ hơn những thủ tục trước là dùng mảng để thực hiện:

Mã:
Sub Chuyen4()
    Dim i As Long, u As Long, mang1, mang2
    'mang2 nhan gia tri tu sheet, luon la mang 2 chieu
    'va index luon bat dau tu 1:
    mang2 = Worksheets("sheet1").Range("A2:A20")
    'lay index cua dong cuoi cung:
    u = UBound(mang2)
    'khai bao lai cho bien mang1 (1 chieu)
    ReDim mang1(1 To u)
    'mang1 nhan gia tri tu mang2:
    For i = 1 To u
        mang1(i) = mang2(i, 1)
    Next
    'gan gia tri tu mang1 vao sheet:
    Worksheets("sheet1").Range("C2").Resize(, u) = mang1
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Thank ban nhé. Vậy từ giờ gặp phải bài toán copy mình có thể tự làm được rùi. cho mình hởi thêm là :
Sự khác nhau giữa "commandbutton" và "button" hay là 2 cái đó giống nhau?
 
Upvote 0
Thank ban nhé. Vậy từ giờ gặp phải bài toán copy mình có thể tự làm được rùi. cho mình hởi thêm là :
Sự khác nhau giữa "commandbutton" và "button" hay là 2 cái đó giống nhau?

2 cái Button này hoàn toàn khác nhau về bản chất.

1) Button là controls thuộc Form Controls, đây là một dạng Shape sau khi insert thì phải Assign Macro thì chúng mới thực hiện được lệnh sau khi click vào.

2) CommandButton là controls thuộc ActiveX Controls, đây là controls có đầy đủ sự kiện của một Button và chỉ hoạt động khi ta viết thủ tục cho sự kiện đó để khi ta kích hoạt sự kiện nào thì chúng sẽ thực thi sự kiện đó.
 

File đính kèm

  • Picture1.jpg
    Picture1.jpg
    28.3 KB · Đọc: 32
Upvote 0
Cảm ơn bạn nhưng cho mình hởi thêm là: Cái commandbutton khi insert lên trang tính thì làm sao để nó hoạt động?
Cái button khi insert lên trang tính mình đã biết cách dùng ghi macro và có thể xây dựng code. Lại giúp mình nữa nhé!
 
Upvote 0
Cảm ơn bạn nhưng cho mình hởi thêm là: Cái commandbutton khi insert lên trang tính thì làm sao để nó hoạt động?
Cái button khi insert lên trang tính mình đã biết cách dùng ghi macro và có thể xây dựng code. Lại giúp mình nữa nhé!

Khi bạn insert nó, hiện tại nó đang ở chế độ thiết kế (Design Mode), bạn double click vào nó, tự nhiên nó hiện trong Sheet Module dòng lệnh thủ tục cho sự kiện Click như sau:

Mã:
Private Sub CommandButton1_Click()


End Sub

Bạn chỉ việc thêm thủ tục của bạn vào giữa chúng, sau đó để sử dụng được thì bạn phải tắt Design Mode này mới bấm được nút lệnh.
 
Upvote 0
Cần giúp đỡ về VBA - Macro

Mình cần giúp đỡ viết code xóa những hàng không có dữ liệu như file đính kèm.
Xin các cao thủ giúp đỡ
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Lần chỉnh sửa cuối:
Upvote 0
Mã:
Sub xoa()
 Dim i As Long
 For i = [G65536].End(3).Row To 4 Step -1
    If Cells(i, 7).Value = "" Then
        Cells(i, 7).EntireRow.Delete
    End If
 Next
 End Sub
Làm một phát luôn, khỏi lặp nè bé Còi:
[GPECODE=vb]Sub Xoa_1()
Range([G4], [G65536].End(xlUp)).SpecialCells(4).EntireRow.Delete
End Sub[/GPECODE]
Nhưng mà cái tiêu đề topic này có vẻ không ổn lắm. Mong rằng các Smod và Mod phụ trách sửa giùm.
 
Upvote 0
Cho mình hỏi 1 chút cũng về hàm IF nhưng trong VBA:
Mã:
    If ((Target.Column = 28) Or (Target.Column = 31) Or (Target.Column = 36) Or _
        (Target.Column = 41) Or (Target.Column = 44) Or (Target.Column = 47) Or _
        (Target.Column = 52) Or (Target.Column = 57)) Then
tức là nếu cột đang chọn là cột 28 hay 31... thì làm gì đó!
Vậy có cách nào để hàm IF này ngắn hơn ko mong các bác chỉ giúp!
 
Lần chỉnh sửa cuối:
Upvote 0
cho em hỏi về muti listbox với ah
- Em muốn tạo ra môt form có 2 listbox gồm nhiều cột, listbox một chứa dữ liệu , khi ta chọn nhứng ITEM trong listbox 1 và bấm nút thì sẽ copy qua box2 (box2 cũng chứa nhiều cột).

em cũng mới biết VBA hơn một tháng nên mong các bác chỉ rõ cho ah em có đính kèm file vd
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
nhờ các cao thủ viết hộ đoạn code

em đang vọc VBA,chưa biết j nhiều,tự làm 1 ví dụ nhưng chưa biết cách giải,mong các anh,chị giúp đỡ,gợi ý.em xin phép post file lên nhờ mọi người
 

File đính kèm

Upvote 0
Các anh cho em hỏi.

Em cần khai báo mảng. Nhưng không biết trước kích thước của mảng. Em khai báo thế này thì nó báo lỗi ở cái "i". i là một biến được em tính toán trong code.
Mã:
Dim Matrix_1(i) as double
Vậy cho em hỏi làm thế nào để khai báo mảng này. Và gán giá trị cho mảng như thế nào.

Ví dụ em cần gán Matrix_1(i-1) thì gán thế nào,
 
Upvote 0
Các anh cho em hỏi.

Em cần khai báo mảng. Nhưng không biết trước kích thước của mảng. Em khai báo thế này thì nó báo lỗi ở cái "i". i là một biến được em tính toán trong code.
Mã:
Dim Matrix_1(i) as double
Vậy cho em hỏi làm thế nào để khai báo mảng này. Và gán giá trị cho mảng như thế nào.

Ví dụ em cần gán Matrix_1(i-1) thì gán thế nào,
Bạn chỉ cần
Dim Matrix_1() as double
Khi bạn đã xác định được số phần tử i rồi bạn dùng
Redim Matrix_1(i)
 
Upvote 0
Các anh cho em hỏi.

Em cần khai báo mảng. Nhưng không biết trước kích thước của mảng. Em khai báo thế này thì nó báo lỗi ở cái "i". i là một biến được em tính toán trong code.
Mã:
Dim Matrix_1(i) as double
Vậy cho em hỏi làm thế nào để khai báo mảng này. Và gán giá trị cho mảng như thế nào.

Ví dụ em cần gán Matrix_1(i-1) thì gán thế nào,


Khi khai báo mảng, nếu ta biết chắc chắn kích thước của nó bao nhiêu thì điền vào luôn, chẳng hạn:

Dim Matrix_1(0 to 9) as double

Lưu ý: Ta phải đảm bảo mảng có bao nhiêu phần tử và chạy từ đâu đến đâu, viết như trên ta thấy được mảng có 10 phần tử, chạy từ 0 đến 9. Nếu ta viết:

Dim Matrix_1(9) as double, thì mảng vẫn chứa 10 phần tử, nhưng mặc định của nó là từ 0 đến 9.

Nhưng ta muốn phần tử đầu tiên, bắt đầu từ 1 thì ta làm như sau:

Dim Matrix_1(1 to 10) as double

---------------------------------------------------

Khi ta không chắc mảng có bao nhiêu phần tử thì bắt buộc ta phải ReDim, cách làm như sau:

Mã:
Sub test()
    Dim TestArray() As Double
    i = 20
    ReDim TestArray(1 To i) As Double
End Sub
 
Upvote 0
Khi khai báo mảng, nếu ta biết chắc chắn kích thước của nó bao nhiêu thì điền vào luôn, chẳng hạn:

Dim Matrix_1(0 to 9) as double

Lưu ý: Ta phải đảm bảo mảng có bao nhiêu phần tử và chạy từ đâu đến đâu, viết như trên ta thấy được mảng có 10 phần tử, chạy từ 0 đến 9. Nếu ta viết:

Dim Matrix_1(9) as double, thì mảng vẫn chứa 10 phần tử, nhưng mặc định của nó là từ 0 đến 9.

Nhưng ta muốn phần tử đầu tiên, bắt đầu từ 1 thì ta làm như sau:

Dim Matrix_1(1 to 10) as double

---------------------------------------------------

Khi ta không chắc mảng có bao nhiêu phần tử thì bắt buộc ta phải ReDim, cách làm như sau:

Mã:
Sub test()
    Dim TestArray() As Double
    i = 20
    ReDim TestArray(1 To i) As Double
End Sub

Cái này em hiểu rồi nhưng còn vấn đề nữa là khi em gán giá trị ví dụ như:

Matrix_1(i) = 120

thì không được. Vậy khi muốn gán giá trị mà chưa biết trước phần tử thì phải làm thế nào
 
Upvote 0
Cái này em hiểu rồi nhưng còn vấn đề nữa là khi em gán giá trị ví dụ như:

Matrix_1(i) = 120

thì không được. Vậy khi muốn gán giá trị mà chưa biết trước phần tử thì phải làm thế nào

Như vầy nha, bạn có Sheet1, tại cột A, từ A1 đến A5 bạn gõ lần lượt từ 1 đến 5 (thử nghiệm nên cho vài phần tử thôi hen).

Và code của bạn sẽ như sau:

Mã:
Sub Test()

    Dim MyRange As Range, MyArray() As Double, _
        EndRow As Long, RowsCount As Long, i As Long
    
[COLOR=#0000ff]    ''Xac dinh so hang cuoi cung co du lieu cua cot A:[/COLOR]
    EndRow = Sheet1.Range("A65536").End(xlUp).Row
    
[COLOR=#0000ff]    ''Dat bien Range cho vung:[/COLOR]
    Set MyRange = Sheet1.Range("A1:A" & EndRow)
    
[COLOR=#0000ff]    ''Xac dinh tong so hang cua vung:[/COLOR]
    RowsCount = MyRange.Rows.Count
    
[COLOR=#0000ff]    ''Dat lai bien cho Array:[/COLOR]
    ReDim MyArray(1 To RowsCount) As Double
    
[COLOR=#0000ff]    ''Gan gia tri cho tung phan tu cua mang:[/COLOR]
    For i = 1 To RowsCount
[COLOR=#ff0000]        MyArray(i) = MyRange(i)[/COLOR]
[COLOR=#0000ff]        ''Xem ket qua:[/COLOR]
        MsgBox MyArray(i)
    Next
    
End Sub

Tôi nghĩ sau khi xem code và làm thực tế bạn sẽ hiểu cách gán giá trị cho từng phần tử trong mảng.
 
Upvote 0
Như vầy nha, bạn có Sheet1, tại cột A, từ A1 đến A5 bạn gõ lần lượt từ 1 đến 5 (thử nghiệm nên cho vài phần tử thôi hen).

Và code của bạn sẽ như sau:

Mã:
Sub Test()

    Dim MyRange As Range, MyArray() As Double, _
        EndRow As Long, RowsCount As Long, i As Long
    
[COLOR=#0000ff]    ''Xac dinh so hang cuoi cung co du lieu cua cot A:[/COLOR]
    EndRow = Sheet1.Range("A65536").End(xlUp).Row
    
[COLOR=#0000ff]    ''Dat bien Range cho vung:[/COLOR]
    Set MyRange = Sheet1.Range("A1:A" & EndRow)
    
[COLOR=#0000ff]    ''Xac dinh tong so hang cua vung:[/COLOR]
    RowsCount = MyRange.Rows.Count
    
[COLOR=#0000ff]    ''Dat lai bien cho Array:[/COLOR]
    ReDim MyArray(1 To RowsCount) As Double
    
[COLOR=#0000ff]    ''Gan gia tri cho tung phan tu cua mang:[/COLOR]
    For i = 1 To RowsCount
[COLOR=#ff0000]        MyArray(i) = MyRange(i)[/COLOR]
[COLOR=#0000ff]        ''Xem ket qua:[/COLOR]
        MsgBox MyArray(i)
    Next
    
End Sub

Tôi nghĩ sau khi xem code và làm thực tế bạn sẽ hiểu cách gán giá trị cho từng phần tử trong mảng.

Cảm ơn anh. Em hiểu rồi
 
Upvote 0
các anh chị dịch hộ em đoạn code sau có ý nghĩa như nào với :

Do Until Selection.Offset(0, 2) = ""
Set X = Selection
Set sRng = Rng.Find(X, , xlFormulas, xlWhole)
Selection.Offset(1, 0).Select
'If sRng Is Nothing Or sRng(2, 2) = "" Then
'Selection.Offset(-1, 0).Font.ColorIndex = 3
'Else
'If sRng(3, 2) = "" Then sRng(2, 2).EntireRow.Copy
'If sRng(3, 2) <> "" Then Range(sRng(2, 2), sRng(2, 2).End(xlDown)).EntireRow.Copy
'Selection.Insert Shift:=xlDown
'Selection.End(xlDown).Select
'End If
thank!
 
Upvote 0
các anh chị dịch hộ em đoạn code sau có ý nghĩa như nào với :

Do Until Selection.Offset(0, 2) = ""
Set X = Selection
Set sRng = Rng.Find(X, , xlFormulas, xlWhole)
Selection.Offset(1, 0).Select
'If sRng Is Nothing Or sRng(2, 2) = "" Then
'Selection.Offset(-1, 0).Font.ColorIndex = 3
'Else
'If sRng(3, 2) = "" Then sRng(2, 2).EntireRow.Copy
'If sRng(3, 2) <> "" Then Range(sRng(2, 2), sRng(2, 2).End(xlDown)).EntireRow.Copy
'Selection.Insert Shift:=xlDown
'Selection.End(xlDown).Select
'End If
thank!
Cả 1 trời kiến thức bên trong mấy dòng lệnh sao mà dịch ra hết được.
Trước tiên bạn phải hiểu về vòng lặp Do ... Loop
Tham khảo mấy cái cơ bản này hiểu rồi mới mổ xẻ thêm được
PHP:
Sub Do_Example()
Dim m As Long
Do
   m = m + 1
   MsgBox m
   If m > 10 Then Exit Do
Loop
End Sub
Sub Do_While_Loop_Example()
Dim i As Long
i = 1
Do While i <= 10
   Cells(i, 1) = i
   i = i + 1
   MsgBox i
Loop
End Sub
Sub Do_Loop_While_Example()
Dim i As Long
i = 1
Do
   Cells(i, 3) = i
   i = i + 1
   MsgBox i
Loop While i <= 10
End Sub
Sub Do_Until_Loop_Example()
Dim i As Long
i = 1
Do Until i = 10
   Cells(i, 5) = i
   i = i + 1
   MsgBox i
Loop
End Sub
 
Upvote 0
thế anh gt hộ em mấy dòng này
'If sRng(3, 2) = "" Then sRng(2, 2).EntireRow.Copy

'If sRng(3, 2) <> "" Then Range(sRng(2, 2), sRng(2, 2).End(xlDown)).EntireRow.Copy
'Selection.Insert Shift:=xlDown
'Selection.End(xlDown).Select
thế anh ơi, sRng(3,2) ở đây (3,2) là số dòng,và số cột của mảng ah
mới lại cấu trúc <>
"" Then Range(sRng(2, 2), sRng(2, 2).End(xlDown)).EntireRow.Copy nghĩa là j
end(xldown),end(xlup) là j
Selection.Insert Shift:=xlDown dòng này nghĩa là j
anh gt hộ em cái,

 
Upvote 0
thế anh gt hộ em mấy dòng này
'If sRng(3, 2) = "" Then sRng(2, 2).EntireRow.Copy

'If sRng(3, 2) <> "" Then Range(sRng(2, 2), sRng(2, 2).End(xlDown)).EntireRow.Copy
'Selection.Insert Shift:=xlDown
'Selection.End(xlDown).Select
thế anh ơi, sRng(3,2) ở đây (3,2) là số dòng,và số cột của mảng ah
mới lại cấu trúc <>
"" Then Range(sRng(2, 2), sRng(2, 2).End(xlDown)).EntireRow.Copy nghĩa là j
end(xldown),end(xlup) là j
Selection.Insert Shift:=xlDown dòng này nghĩa là j
anh gt hộ em cái,

Cứ chạy thử từng dòng lệnh và xem kết quả ở bảng tính thì biết dòng nào có ý nghĩa gì
Chẳng hạn Selection.Insert Shift:= XlDown là chèn thêm 1 vùng vào trước vùng được chọn và đẩy vùng chọn xuống dưới
Down là xuống, Up là lên trên... EntireRow là cả dòng, Copy là copy....
Hic chả biết giải thích thế nào nữa
 
Upvote 0
ok để em nghiên cứu thêm,đúng là hỏi ngu ngơ thì là làm khó các bác,em có một ví dụ nhỏ nhờ các bác viết code,bác rảnh thì nghiên cứu hộ em một tí,thanks bác nhiều nhé
p/s: sheet2 với yêu cầu là cứ gõ mã thì tên,đơn vị,giá sẽ tự động hiện (em đã làm)
sheet4 yêu cầu là khi chạy macro thì sẽ phân tích các mã ở sheet 2 cụ thể ra
cơ sở dữ liệu lấy ở sheet1,3,5
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Chào các anh chị, em mới học về excel nên còn lơ ngơ lắm -+*/ hàng ngày em phải lấy 1 file từ hệ thống xuống, rồi cắt lọc file đấy ra để được một file hoàn chỉnh, rất là thủ công !$@!! mong anh chị chỉ bảo em xem có cách nào tự động được ko ...

Ở file đính kèm thì file "bat dau" là file cần xử lý để thành file "ket thuc"

Mong các anh chị giúp đỡ ...
 

File đính kèm

Upvote 0
Chào các anh chị, em mới học về excel nên còn lơ ngơ lắm -+*/ hàng ngày em phải lấy 1 file từ hệ thống xuống, rồi cắt lọc file đấy ra để được một file hoàn chỉnh, rất là thủ công !$@!! mong anh chị chỉ bảo em xem có cách nào tự động được ko ...

Ở file đính kèm thì file "bat dau" là file cần xử lý để thành file "ket thuc"

Mong các anh chị giúp đỡ ...

Bạn dùng tạm cái củ chuối này xem sao.
 

File đính kèm

Upvote 0
mấy bác ơi không biết code của em lỗi ở đâu,nghịch mãi mà ko biết sửa thế nào

Sub phantichdongia()
Sheets("sheet2").Select
Range([a2], [a30].End(xlUp)).Select
'Copy STT va MHDG:
'Selection.Copy Sheets(2).[a1]
Selection.Copy Sheets("sheet4").[a2]
'Copy ten va don vi cong viec:
Range(Selection.Offset(0, 1), Selection.Offset(0, 2)).Copy Sheets("sheet4").[c2]
'Link khoi luong:
Selection.Offset(0, 3).Copy
Sheets("sheet4").Select
Range("f2").Select
ActiveSheet.Paste Link:=True


'copy tu bang dm
Range("a2").Select
'Khai bao:
Dim Sh As Worksheet, Rng As Range, sRng As Range
Set Sh = Sheets("sheet3")
Set Rng = Sh.Range(Sh.[a2], Sh.[a30].End(xlUp))
'Chu ky tao bang PTVT
Do Until Selection.Offset(0, 2) = ""
Set X = Selection
Set sRng = Rng.Find(X, , xlFormulas, xlWhole)
Selection.Offset(1, 0).Select


If sRng Is Nothing Then
Application.ScreenUpdating = True
Application.EnableEvents = True
Selection.Font.ColorIndex = 3
MsgBox "Cong viec co ma hieu : ''" & X & "'' chua duoc cap nhat trong bang dinh muc !" & Chr(13) & "Hay kiem tra du lieu trong bang ''DinhMuc''.", vbOKOnly, "???"
Exit Sub
Else
Range(sRng(2, 1), sRng(2, 1).End(xlDown)).EntireRow.Copy
Selection.Insert Shift:=xlDown
Selection.End(xlDown).Select
End If
Loop
Application.CutCopyMode = False

End Sub

file đây ạ
 

File đính kèm

Upvote 0
Sửa code lọc dữ liệu

Em có file đính kèm, em đã nêu cụ thể trong file giúp em sửa lại code
Thanks!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
các Bro Giúp em với Em gặp vấn đề về add ngày tháng
-thứ nhất là khi em add ngày tháng từ listbox sang textbox thì ngày tháng bị chuyển thành dạng text
- Thứ hai là khi add ngày tháng từ listbox vào cell thì từ ngày 12 trở xuống ngày tháng là mm/dd/yyyy còn ngày từ 13 trở lên thì có dạng dd/mm/yyyy.
Mong mọi người giúp em giải quyết vấn đề này với ạ
 
Lần chỉnh sửa cuối:
Upvote 0
Mấy bác cho em hỏi em muốn chèn một vùng dữ liệu từ sheet sang userform ( bất kỳ cái gì của userform cũng được ) thì muốn làm sao ạ. Em mới tập tẹ vào nghề nên mong được các pro giải đáp ạ
 
Upvote 0
Xin chào các bạn,

Mình có 1 vấn đề muốn hỏi các bạn về vòng lặp trong excel, cơ bản như sau (xin xem file đính kèm):

-Mình có 1 danh sách model name, và brand trong sheet 1
-Mình muốn chọn tất cả các model name có tên brand là "n123", theo thứ tự từ trên xuống vào trong sheet 2 (cũng theo thứ tự từ trên xuống, và không bỏ trống hàng nào)
-Không dùng filter, vì mình sẽ phải phân loại, copy, paste rất nhiều lần cho từng brand vào các sheet khác nhau.

Xin chân thành cám ơn sự giúp đỡ của các bạn.
 

File đính kèm

Upvote 0
Xin chào các bạn,

Mình có 1 vấn đề muốn hỏi các bạn về vòng lặp trong excel, cơ bản như sau (xin xem file đính kèm):

-Mình có 1 danh sách model name, và brand trong sheet 1
-Mình muốn chọn tất cả các model name có tên brand là "n123", theo thứ tự từ trên xuống vào trong sheet 2 (cũng theo thứ tự từ trên xuống, và không bỏ trống hàng nào)
-Không dùng filter, vì mình sẽ phải phân loại, copy, paste rất nhiều lần cho từng brand vào các sheet khác nhau.

Xin chân thành cám ơn sự giúp đỡ của các bạn.

Bạn dùng Pivot table sẽ ra tất cả các brand, mỗi brand sẽ ra tất cả các name, theo thứ tự.

Hoặc đơn giản hơn, bạn sort theo cột brand, thế là chỉ copy từng phần brand sang các sheet.
 
Upvote 0
Xin chào các bạn,

Mình có 1 vấn đề muốn hỏi các bạn về vòng lặp trong excel, cơ bản như sau (xin xem file đính kèm):

-Mình có 1 danh sách model name, và brand trong sheet 1
-Mình muốn chọn tất cả các model name có tên brand là "n123", theo thứ tự từ trên xuống vào trong sheet 2 (cũng theo thứ tự từ trên xuống, và không bỏ trống hàng nào)
-Không dùng filter, vì mình sẽ phải phân loại, copy, paste rất nhiều lần cho từng brand vào các sheet khác nhau.

Xin chân thành cám ơn sự giúp đỡ của các bạn.
Bạn xem thử coi ok không
 
Upvote 0
ok để em nghiên cứu thêm,đúng là hỏi ngu ngơ thì là làm khó các bác,em có một ví dụ nhỏ nhờ các bác viết code,bác rảnh thì nghiên cứu hộ em một tí,thanks bác nhiều nhé
p/s: sheet2 với yêu cầu là cứ gõ mã thì tên,đơn vị,giá sẽ tự động hiện (em đã làm)
sheet4 yêu cầu là khi chạy macro thì sẽ phân tích các mã ở sheet 2 cụ thể ra
cơ sở dữ liệu lấy ở sheet1,3,5
chưa hiểu khúc này là bạn muốn ntn?
 
Upvote 0
Gán giá trị vào mảng.

Mình đang học về mảng, nhờ các bạn giải thích giúp :

Sub LearnArray()
Dim Arr, i As Long, j As Long

Arr = Sheet2.Range("F5:I10").Value

For Each k In Arr
MsgBox k
Next k

For i = LBound(Arr, 1) To UBound(Arr, 1)
For j = LBound(Arr, 2) To UBound(Arr, 2)
MsgBox Arr(i, 1)
Next j
Next i
End Sub

Khi dùng gán mảng bằng 1 vùng nếu dùng For each duyệt qua từng phần tử của mảng thì nhận giá trị của từng mảng. Còn khi dùng For i = Lbound to Ubound thì không nhận giá trị của mảng.
 
Upvote 0
Mình đang học về mảng, nhờ các bạn giải thích giúp :

Sub LearnArray()
Dim Arr, i As Long, j As Long

Arr = Sheet2.Range("F5:I10").Value

For Each k In Arr
MsgBox k
Next k

For i = LBound(Arr, 1) To UBound(Arr, 1)
For j = LBound(Arr, 2) To UBound(Arr, 2)
MsgBox Arr(i, 1)
Next j
Next i
End Sub

Khi dùng gán mảng bằng 1 vùng nếu dùng For each duyệt qua từng phần tử của mảng thì nhận giá trị của từng mảng. Còn khi dùng For i = Lbound to Ubound thì không nhận giá trị của mảng.
Chổ màu đỏ phải là Arr(i, j) chứ sao lại là Arr(i, 1)?
 
Upvote 0
Hỏi cách kiểm tra tất cả các cell không rổng:

nhờ anh chị chỉ giúp cho các kiểm tra để biết các cell không liên tục và không rổng.
ví dụ để biết các cell sau đây không rổng
[A1], [A3],[A5],[A7],[B2],[B4],[B6]
Làm sao để biết tất cả các cell này đã được điền số liệu
(hiên tôi phải sử dụng worksheetfuction counta hoặc vòng lặp qua các cell).
có thể sử dụng empty kết hợp với union không ạ?
cám ơn mọi người giúp đỡ
 
Upvote 0
Hỏi cách kiểm tra tất cả các cell không rổng:

nhờ anh chị chỉ giúp cho các kiểm tra để biết các cell không liên tục và không rổng.
ví dụ để biết các cell sau đây không rổng
[A1], [A3],[A5],[A7],[B2],[B4],[B6]
Làm sao để biết tất cả các cell này đã được điền số liệu
(hiên tôi phải sử dụng worksheetfuction counta hoặc vòng lặp qua các cell).
có thể sử dụng empty kết hợp với union không ạ?
cám ơn mọi người giúp đỡ
Miêu tả cụ thể và thực tế hơn được không bạn !
 
Upvote 0
Hỏi cách kiểm tra tất cả các cell không rổng:

nhờ anh chị chỉ giúp cho các kiểm tra để biết các cell không liên tục và không rổng.
ví dụ để biết các cell sau đây không rổng
[A1], [A3],[A5],[A7],[B2],[B4],[B6]
Làm sao để biết tất cả các cell này đã được điền số liệu
(hiên tôi phải sử dụng worksheetfuction counta hoặc vòng lặp qua các cell).
có thể sử dụng empty kết hợp với union không ạ?
cám ơn mọi người giúp đỡ
Xem code ví dụ
PHP:
Sub BlankChk()
Dim Sarr As Range, item As Range
Set Sarr = Union([A1], [A3], [A5], [A7])
For Each item In Sarr
   If item = Empty Then
      MsgBox item.Address(0, 0) & " is empty"
   End If
Next
End Sub
 
Upvote 0

File đính kèm

Upvote 0
cám ơn anh,anh xem giúp................



@anh Quang Hai,

hiện nay tôi cũng đang dùng vòng lặp.
nhưng tôi không biết là có cách nào không dùng vòng lặp không
cám ơn anh

Nếu mà theo kiểu oánh võ rừng thì có cách này, hơi tà ma ngoại đạo chút.
PHP:
Sub test()
Dim Sarr As Range, Chk1 As Long, Chk2 As Long
Set Sarr = Union([A1], [A3], [A5], [B2], [B4])
Chk1 = Application.CountA(Sarr)
Chk2 = Sarr.Count
If Chk2 - Chk1 > 0 Then MsgBox "Con thieu thong tin" Else MsgBox "Du thong tin"
End Sub
 
Upvote 0
cám ơn anh,anh xem giúp................



@anh Quang Hai,

hiện nay tôi cũng đang dùng vòng lặp.
nhưng tôi không biết là có cách nào không dùng vòng lặp không
cám ơn anh

Bạn có thể tham khảo code của a QuangHai1969
Mình chỉ góp ý thế này thôi:
* Bạn dùng sự kiện theo kiểu DoChange ,tức là khi nhập, thay đổi dữ liệu tại 1 ô nào đó trong vùng kiểm tra sẽ hiện ra msgbox thông báo --> cái này có thực sự tiện lợi không <-------- tôi thì thấy cái này rất bất tiện,( nếu chỉ có 1 ,2 ô thì không sao, đằng này lại gần như là 1 vùng range )
* Giống như việc bạn khai báo đăng ký thông tin trên các trang web --> khi bạn ấn nút ok hay submit --> thì chương trình mới kiểm tra dữ liệu nhập vào có phù hợp hay thỏa mãn điều kiện ban đầu không ? <--- theo tôi đây mới là giải pháp hợp lý !

p/s : trong code của bạn có đoạn :
Mã:
If cll.Value = 0 Then
điều kiện trên sẽ khác với điều kiện này bạn nhé:
Mã:
If cll <>"" Then
hay 
Ìf Cll =Empty then
 
Lần chỉnh sửa cuối:
Upvote 0
đã giải quyết được vấn đề

nhờ mod xóa giúp.

cám ơn và xin lổi vì đã làm phiền.
 
Lần chỉnh sửa cuối:
Upvote 0
Macro có thể gọi hảm đã cài vào add In không.
xin chào anh chi,
tôi có một cái hàm tự tạo, đã cài vào Add In.
rồi ở một Sub gọi tên hàm này nhưng không được.(bị báo lổi)
vậy cho hỏi trong Sub gọi Function trong add in được không ạ,
tôi hỏi vậy vì tôi cần chép một đoạn code cho 20-30 file sử dụng, mà chép vào từng file cũng hôi lười, nên định add in
cám ơn các anh chi
 
Upvote 0
Macro có thể gọi hảm đã cài vào add In không.
xin chào anh chi,
tôi có một cái hàm tự tạo, đã cài vào Add In.
rồi ở một Sub gọi tên hàm này nhưng không được.(bị báo lổi)
vậy cho hỏi trong Sub gọi Function trong add in được không ạ,
tôi hỏi vậy vì tôi cần chép một đoạn code cho 20-30 file sử dụng, mà chép vào từng file cũng hôi lười, nên định add in
cám ơn các anh chi
Dĩ nhiên là có 2 cách:
1. Gọi hàm trong Sub, tính toán và trả về dữ liệu trên cell. Với cách này, khi dữ liệu tham chiếu thay đổi thì phải chạy lại Sub.
2. Sub đặt hàm trên cell để tính toán. Với cách này, khi dữ liệu tham chiếu của hàm thay đổi thì hàm sẽ tự tính toán lại.
 
Upvote 0
Hỏi về câu lệnh chỉ chạy trong một Sheet nào đó trong một Workbook?

Xin chào Thầy Cô và Anh Chị!
Em đang vướng mắc một vấn đề này mong mọi người giúp đỡ ạ.
ví dụ em muốn khi di chuyển đến sheet2 thì ô A1 của sheet 2 này ra kết quả là 1.
Còn khi di chuyển đến các sheet khác (ngoài sheet2) thì ô A1 của Sheet2 sẽ cho kết quả là 0.
Vấn đề tưởng chừng đơn giản quá nhưng chưa thể làm được với cấu lệnh:
Mã:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
...
End Sub
 
Upvote 0
Xin chào Thầy Cô và Anh Chị!
Em đang vướng mắc một vấn đề này mong mọi người giúp đỡ ạ.
ví dụ em muốn khi di chuyển đến sheet2 thì ô A1 của sheet 2 này ra kết quả là 1.
Còn khi di chuyển đến các sheet khác (ngoài sheet2) thì ô A1 của Sheet2 sẽ cho kết quả là 0.
Vấn đề tưởng chừng đơn giản quá nhưng chưa thể làm được với cấu lệnh:
Mã:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
...
End Sub
Thì chèn lệnh vào
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Name = "Sheet2" Then
[A1] = 1
Else
[A1] = 0
End If
End Sub
 
Upvote 0
Xin chào Thầy Cô và Anh Chị!
Em đang vướng mắc một vấn đề này mong mọi người giúp đỡ ạ.
ví dụ em muốn khi di chuyển đến sheet2 thì ô A1 của sheet 2 này ra kết quả là 1.
Còn khi di chuyển đến các sheet khác (ngoài sheet2) thì ô A1 của Sheet2 sẽ cho kết quả là 0.
Vấn đề tưởng chừng đơn giản quá nhưng chưa thể làm được với cấu lệnh:
Mã:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
...
End Sub
Mã:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.CodeName = "Sheet2" Then
        Sheet2.[A1] = 1
    Else
        Sheet2.[A1] = 0
    End If
End Sub
Mục đích của bạn là làm gì vậy?
ban quanghai1969 xem lại thử chỗ nì
Thì chèn lệnh vào
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Name = "Sheet2" Then
[A1] = 1
Else
[A1] = 0 '<= Nếu ActiveSheet <> Sheet2 ví dụ là Sheet1 thì chỗ nì Sheet1.[A1] = 0 sao?

End If
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Mã:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If [COLOR=#0000cd][B]Sh.CodeName = "Sheet2"[/B][/COLOR] Then
        Sheet2.[A1] = 1
    Else
        Sheet2.[A1] = 0
    End If
End Sub
Mục đích của bạn là làm gì vậy
ban quanghai1969 xem lại bị sai nhé

Thì ra là vậy! Cảm ơn bạn rất nhiều!!
À mục đích của mình cũng để chỉ dựa vào con số này để If và Else cho các đoạn code mà thôi ^^
 
Upvote 0
Mã:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.CodeName = "Sheet2" Then
        Sheet2.[A1] = 1
    Else
        Sheet2.[A1] = 0
    End If
End Sub
Mục đích của bạn là làm gì vậy
ban quanghai1969 xem lại bị sai nhé
Hức hức tưởng đâu là........ nên code không cần file, ai dè trật lất
 
Upvote 0
e đang vướng ở vấn đề liên kết đến sheet khác ... ví dụ
Ban đầu e tạo nút ẩn hết tất cả các sheet trên sheet Menu
Sau đó tạo nút ấn D500 ở sheet Menu khi nhấn vào thì sẽ hiện đồng thời 2 sheet D510 và D520, nút ấn D600 ở sheet Menu thì khi nhấn vào sẽ hiện đồng thời 2 sheet D610 và D620, tương tự các nút ấn khác sẽ chuyển đến 2 sheet khác ...
Nhưng
em tìm trên GPE và cả google cũng chỉ có macro liên kết từ sheet này đến 1 sheet khác
Sub LinktoSheet()
With ActiveSheet
With Sheets(.Shapes(Application.Caller).AlternativeText)
.Visible = True: .Select
End With
.Visible = 2
End With
End Sub
Mong thầy cô và ac nào biết giúp e, e cảm ơn !!!
 
Upvote 0
Hỏi về một cái gì đó xảy ra theo điều kiện selection trong một vùng dữ liệu?

Chào các bạn!Mình đang vướng mắc một sự cố mong các bạn giúp đỡ.

ví dụ với đoạn code này thì OK.
Mã:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = [COLOR=#008000][B]Range("C2")[/B][/COLOR].Address Then Range("A1").Value = 1
    If Target.Address = [COLOR=#008000][B]Range("E2")[/B][/COLOR].Address Then Range("A1").Value = 0
End Sub

Nhưng mình muốn mở rộng hơn 1 chút nữa là chuyển từ 1 Cell thành 1 vùng thì thế này:
Mã:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = [COLOR=#ff0000][B]Range("C2:C10")[/B][/COLOR].Address Then Range("A1").Value = 1
    If Target.Address = [COLOR=#ff0000][B]Range("E2:E10")[/B][/COLOR].Address Then Range("A1").Value = 0
End Sub

Kết quả là không thấy có hiện tượng gì.
Phiền các bạn chỉ giúp mình làm sao để khi di chuyển vùng theo trường hợp 2 thì điều kiện có thể hoạt động được với.

Xin cảm ơn!
 
Lần chỉnh sửa cuối:
Upvote 0
Chào các bạn!Mình đang vướng mắc một sự cố mong các bạn giúp đỡ.

ví dụ với đoạn code này thì OK.
Mã:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = [COLOR=#008000][B]Range("C2")[/B][/COLOR].Address Then Range("A1").Value = 1
    If Target.Address = [COLOR=#008000][B]Range("E2")[/B][/COLOR].Address Then Range("A1").Value = 0
End Sub

Nhưng mình muốn mở rộng hơn 1 chút nữa là chuyển từ 1 Cell thành 1 vùng thì thế này:
Mã:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = [COLOR=#ff0000][B]Range("C2:C10")[/B][/COLOR].Address Then Range("A1").Value = 1
    If Target.Address = [COLOR=#ff0000][B]Range("E2:E10")[/B][/COLOR].Address Then Range("A1").Value = 0
End Sub

Kết quả là không thấy có hiện tượng gì.
Phiền các bạn chỉ giúp mình làm sao để khi di chuyển vùng theo trường hợp 2 thì code không bị lỗi với.

Xin cảm ơn!

Bạn chạy thử code này:

Mã:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("C2:C10")) Is Nothing Then Range("A1").Value = 1
    If Not Intersect(Target, Range("E2:E10")) Is Nothing Then Range("A1").Value = 0
End Sub
 
Upvote 0
Cảm ơn bạn nhiều code đã hoạt động đúng ý mình!
 
Upvote 0
xin chào ACE, tôi đang mài mò thử hoc Dictionary để lọc giá trị duy nhất trong một danh sách với d0ọc code sau
Mã:
Private Sub CommandButton1_Click()
Dim Dic As Object, I As Long, J As Long, K As Long, Arr(), dArr(), Tem As String
[f5:G100].ClearContents
Arr = [c5:D13].Value
ReDim dArr(1 To UBound(Arr, 1), 1 To 2)

For I = 1 To UBound(Arr)
Set Dic = CreateObject("Scripting.Dictionary")
Tem = Arr(I, 1)
    If Not Dic.Exists(Tem) Then
            K = K + 1: Dic.Add Tem, K
            For J = 1 To 2
                dArr(K, J) = Arr(I, J)
            Next J
    End If
Next I

[f5].Resize(K, 2).Value = dArr
Set Dic = Nothing
End Sub

không biết là nó sai chổ nào mà chẳng có lọc gì hết............
nhờ anh chỉ sử lại dùm
cám ơn nhiều
 

File đính kèm

Upvote 0
xin chào ACE, tôi đang mài mò thử hoc Dictionary để lọc giá trị duy nhất trong một danh sách với d0ọc code sau
Mã:
Private Sub CommandButton1_Click()
Dim Dic As Object, I As Long, J As Long, K As Long, Arr(), dArr(), Tem As String
[f5:G100].ClearContents
Arr = [c5:D13].Value
ReDim dArr(1 To UBound(Arr, 1), 1 To 2)

For I = 1 To UBound(Arr)
Set Dic = CreateObject("Scripting.Dictionary")
Tem = Arr(I, 1)
    If Not Dic.Exists(Tem) Then
            K = K + 1: Dic.Add Tem, K
            For J = 1 To 2
                dArr(K, J) = Arr(I, J)
            Next J
    End If
Next I

[f5].Resize(K, 2).Value = dArr
Set Dic = Nothing
End Sub

không biết là nó sai chổ nào mà chẳng có lọc gì hết............
nhờ anh chỉ sử lại dùm
cám ơn nhiều
1)- Híc, sao Set Dic trong vòng lặp, đưa ra ngoài chứ
2)- Khi có dữ liệu trùng thì làm gì, phải thêm vào code
Thân
 
Upvote 0
1)- Híc, sao Set Dic trong vòng lặp, đưa ra ngoài chứ
2)- Khi có dữ liệu trùng thì làm gì, phải thêm vào code
Thân

cám ơn anh, anh ơi cho hoi thêm, nếu nguồn của mình là từ [C5:E13] tức là thêm một cột
nhưng khi lọc thì chỉ lấy ở cột C và E thôi, ko lấy cột D thỉ phải là sao?
 
Upvote 0
cám ơn anh, anh ơi cho hoi thêm, nếu nguồn của mình là từ [C5:E13] tức là thêm một cột
nhưng khi lọc thì chỉ lấy ở cột C và E thôi, ko lấy cột D thỉ phải là sao?

Lấy cột nào thì cứ.. lấy thôi
Mã:
Private Sub CommandButton1_Click()
  Dim Dic As Object, I As Long, J As Long, K As Long, Arr(), dArr(), Tem As String
  [f5:G100].ClearContents
  [COLOR=#ff0000]Arr = [C5:E13].Value[/COLOR]
  ReDim dArr(1 To UBound(Arr, 1), 1 To 2)
  Set Dic = CreateObject("Scripting.Dictionary")
  For I = 1 To UBound(Arr)
    Tem = Arr(I, 1)
    If Not Dic.Exists(Tem) Then
      K = K + 1
      Dic.Add Tem, K
      dArr(K, 1) = Arr(I, 1)
      [COLOR=#ff0000][B]dArr(K, 2) = Arr(I, 3)[/B][/COLOR]
    End If
  Next I
  [f5].Resize(K, 2).Value = dArr
  Set Dic = Nothing
End Sub
Có vấn đề gì chứ
 
Upvote 0
Cho em hỏi Code của chương trình So_Mucke

Đây là Code do bác Ba Tê viết giúp em và em đã cải tiến một số phần để phục vụ công việc tuy nhiên khi xử lý Code thì em chưa có kinh nghiệm nhiều, mọi người cho em hỏi chút ạ
PHP:
Public Sub LOC_BIEU1()
On Error Resume Next
Dim sArr(), dArr(1 To 3, 1 To 1), I As Long, To_BD As String, DK As String, Ong As String, Ong2 As String, Ong3 As String
Dim K As Long, dArr2(1 To 1000, 1 To 12), N As Long, SoTrang As Double, Le As Boolean
Dim loai_DT1 As String, loai_DT2 As String
Dim Cap_GCN1 As String, Cap_GCN2 As String, Cap_GCN3 As String, Cap_GCN4 As String, Cap_GCN5 As String, Cap_GCN6 As String
Dim Cap_GCN7 As String, Cap_GCN8 As String, Cap_GCN9 As String, Cap_GCN10 As String, Cap_GCN11 As String, Cap_GCN12 As String
Dim Cap_GCN13 As String, Cap_GCN14 As String, Cap_GCN15 As String, Cap_GCN16 As String, Cap_GCN17 As String, Cap_GCN18 As String
Dim Cap_GCN19 As String, Cap_GCN20 As String, Cap_GCN21 As String, Cap_GCN22 As String, Cap_GCN23 As String, Cap_GCN24 As String
Dim Cap_GCN25 As String, Cap_GCN26 As String, Cap_GCN27 As String, Cap_GCN28 As String, Cap_GCN29 As String, Cap_GCN30 As String
Dim Cap_GCN31 As String, Cap_GCN32 As String, Cap_GCN33 As String, Cap_GCN34 As String, Cap_GCN35 As String, Cap_GCN36 As String
Dim Cap_GCN37 As String, Cap_GCN38 As String, Cap_GCN39 As String, Cap_GCN40 As String
With Sheets("DATA")
    sArr = .Range(.[A3], .[A65536].End(xlUp)).Resize(, 21).Value
End With

With Sheets("BIEU")
DK = .[M5].Value: To_BD = .[O7].Value: Ong = .[O8].Value: Ong2 = .[O9].Value: Ong3 = .[O10].Value
loai_DT1 = .[O11].Value: loai_DT2 = .[O12].Value
Cap_GCN1 = .[X5].Value: Cap_GCN2 = .[X6].Value: Cap_GCN3 = .[X7].Value: Cap_GCN4 = .[X8].Value: Cap_GCN5 = .[X9].Value: Cap_GCN6 = .[X10].Value
Cap_GCN7 = .[X11].Value: Cap_GCN8 = .[X12].Value: Cap_GCN9 = .[X13].Value: Cap_GCN10 = .[X14].Value: Cap_GCN11 = .[X15].Value: Cap_GCN12 = .[X16].Value
Cap_GCN13 = .[X17].Value: Cap_GCN14 = .[X18].Value: Cap_GCN15 = .[X19].Value: Cap_GCN16 = .[X20].Value: Cap_GCN17 = .[X21].Value: Cap_GCN18 = .[X22].Value
Cap_GCN19 = .[X23].Value: Cap_GCN20 = .[X24].Value: Cap_GCN21 = .[X25].Value: Cap_GCN22 = .[X26].Value: Cap_GCN23 = .[X27].Value: Cap_GCN24 = .[X28].Value
Cap_GCN25 = .[X29].Value: Cap_GCN26 = .[X30].Value: Cap_GCN27 = .[X31].Value: Cap_GCN28 = .[X32].Value: Cap_GCN29 = .[X33].Value: Cap_GCN30 = .[X34].Value
Cap_GCN31 = .[X35].Value: Cap_GCN32 = .[X36].Value: Cap_GCN33 = .[X37].Value: Cap_GCN34 = .[X38].Value: Cap_GCN35 = .[X39].Value: Cap_GCN36 = .[X40].Value
Cap_GCN37 = .[X41].Value: Cap_GCN38 = .[X42].Value: Cap_GCN39 = .[X43].Value: Cap_GCN40 = .[X44].Value

For I = 1 To UBound(sArr, 1)
    If sArr(I, 1) = DK Then
        dArr(1, 1) = To_BD & sArr(I, 1)
Exit For
    End If
Next I
For N = I To UBound(sArr, 1)
    If sArr(N, 1) = DK Then
        K = K + 1
                dArr2(K, 1) = sArr(N, 2)
                dArr2(K, 4) = sArr(N, 4)
                dArr2(K, 7) = sArr(N, 5)
        
        If sArr(N, 5) = "LUC" Then
                dArr2(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "LUK" Then
                dArr2(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "LUN" Then
                dArr2(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "COC" Then
                dArr2(K, 5) = Cap_GCN2
            ElseIf sArr(N, 5) = "BHK" Then
                dArr2(K, 5) = Cap_GCN3
            ElseIf sArr(N, 5) = "NHK" Then
                dArr2(K, 5) = Cap_GCN3
            ElseIf sArr(N, 5) = "LNC" Then
                dArr2(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "LNQ" Then
                dArr2(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "LNk" Then
                dArr2(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "TSL" Then
                dArr2(K, 5) = Cap_GCN5
            ElseIf sArr(N, 5) = "TSN" Then
                dArr2(K, 5) = Cap_GCN5
            ElseIf sArr(N, 5) = "LMU" Then
                dArr2(K, 5) = Cap_GCN6
            ElseIf sArr(N, 5) = "NKH" Then
                dArr2(K, 5) = Cap_GCN7
            ElseIf sArr(N, 5) = "RSN" Then
                dArr2(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RST" Then
                dArr2(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RSK" Then
                dArr2(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RSM" Then
                dArr2(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RPN" Then
                dArr2(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPT" Then
                dArr2(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPK" Then
                dArr2(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPM" Then
                dArr2(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RDN" Then
                dArr2(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDT" Then
                dArr2(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDK" Then
                dArr2(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDM" Then
                dArr2(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "ONT" Then
                dArr2(K, 5) = Cap_GCN11
            ElseIf sArr(N, 5) = "ODT" Then
                dArr2(K, 5) = Cap_GCN12
            ElseIf sArr(N, 5) = "TSC" Then
                dArr2(K, 5) = Cap_GCN13
            ElseIf sArr(N, 5) = "TSK" Then
                dArr2(K, 5) = Cap_GCN14
            ElseIf sArr(N, 5) = "CQP" Then
                dArr2(K, 5) = Cap_GCN15
            ElseIf sArr(N, 5) = "CAN" Then
                dArr2(K, 5) = Cap_GCN16
            ElseIf sArr(N, 5) = "SKK" Then
                dArr2(K, 5) = Cap_GCN17
            ElseIf sArr(N, 5) = "SKC" Then
                dArr2(K, 5) = Cap_GCN18
            ElseIf sArr(N, 5) = "SKS" Then
                dArr2(K, 5) = Cap_GCN19
            ElseIf sArr(N, 5) = "SKX" Then
                dArr2(K, 5) = Cap_GCN20
            ElseIf sArr(N, 5) = "DGT" Then
                dArr2(K, 5) = Cap_GCN21
            ElseIf sArr(N, 5) = "DTL" Then
                dArr2(K, 5) = Cap_GCN22
            ElseIf sArr(N, 5) = "DNL" Then
                dArr2(K, 5) = Cap_GCN23
            ElseIf sArr(N, 5) = "DBV" Then
                dArr2(K, 5) = Cap_GCN24
            ElseIf sArr(N, 5) = "DVH" Then
                dArr2(K, 5) = Cap_GCN25
            ElseIf sArr(N, 5) = "DYT" Then
                dArr2(K, 5) = Cap_GCN26
            ElseIf sArr(N, 5) = "DGD" Then
                dArr2(K, 5) = Cap_GCN27
            ElseIf sArr(N, 5) = "DTT" Then
                dArr2(K, 5) = Cap_GCN28
            ElseIf sArr(N, 5) = "DKH" Then
                dArr2(K, 5) = Cap_GCN29
            ElseIf sArr(N, 5) = "DXH" Then
                dArr2(K, 5) = Cap_GCN30
            ElseIf sArr(N, 5) = "DCH" Then
                dArr2(K, 5) = Cap_GCN31
            ElseIf sArr(N, 5) = "DDT" Then
                dArr2(K, 5) = Cap_GCN32
            ElseIf sArr(N, 5) = "DRA" Then
                dArr2(K, 5) = Cap_GCN33
            ElseIf sArr(N, 5) = "TON" Then
                dArr2(K, 5) = Cap_GCN34
            ElseIf sArr(N, 5) = "TIN" Then
                dArr2(K, 5) = Cap_GCN35
            ElseIf sArr(N, 5) = "NTD" Then
                dArr2(K, 5) = Cap_GCN36
            ElseIf sArr(N, 5) = "SON" Then
                dArr2(K, 5) = Cap_GCN37
            ElseIf sArr(N, 5) = "MNC" Then
                dArr2(K, 5) = Cap_GCN38
            ElseIf sArr(N, 5) = "PNK" Then
                dArr2(K, 5) = Cap_GCN39
            ElseIf sArr(N, 5) = "BCS" Then
                dArr2(K, 5) = Cap_GCN40
            ElseIf sArr(N, 5) = "DCS" Then
                dArr2(K, 5) = Cap_GCN40
            ElseIf sArr(N, 5) = "NCS" Then
                dArr2(K, 5) = Cap_GCN40
            
            Else
                dArr2(K, 5) = vbNullString
        End If
         
         If sArr(N, 6) = 1 Then
                dArr2(K, 3) = loai_DT1
            ElseIf sArr(N, 6) = 2 Then
                dArr2(K, 3) = loai_DT1
            ElseIf sArr(N, 6) = 3 Then
                dArr2(K, 3) = loai_DT2
            ElseIf sArr(N, 6) = 4 Then
                dArr2(K, 3) = loai_DT2
            ElseIf sArr(N, 6) = 5 Then
                dArr2(K, 3) = loai_DT2
            Else
                dArr2(K, 3) = vbNullString
        End If
                
                
        If sArr(N, 6) = 1 Then
                dArr2(K, 2) = Ong & sArr(N, 3)
            ElseIf sArr(N, 6) = 2 Then
                dArr2(K, 2) = Ong2 & sArr(N, 3)
            ElseIf sArr(N, 6) = 3 Then
                dArr2(K, 2) = Ong3 & sArr(N, 3)
            ElseIf sArr(N, 6) = 4 Then
                dArr2(K, 2) = Ong3 & sArr(N, 3)
            ElseIf sArr(N, 6) = 5 Then
                dArr2(K, 2) = Ong3 & sArr(N, 3)
            Else
                dArr2(K, 2) = vbNullString
        End If
    End If
Next N
Application.EnableEvents = False
.[A1].Value = dArr
.[A5:L43].Value = dArr2
SoTrang = K \ 39
If SoTrang > 0 Then
    If K Mod 39 > 0 Then SoTrang = SoTrang + 1
Else
    SoTrang = 1
End If
.[N4].Value = SoTrang
.[O4].Value = 1
Application.EnableEvents = True
End With
End Sub


Public Sub LOC_BIEU2()
Dim sArr(), dArr(), dArr2(), I As Long, J As Long, K As Long, N As Long, K1 As Long, XemTrang As Long
Dim SoTrang As Long, D As Long, DK As String, Ong As String, Ong2 As String, Ong3 As String
Dim loai_DT1 As String, loai_DT2 As String
Dim Cap_GCN1 As String, Cap_GCN2 As String, Cap_GCN3 As String, Cap_GCN4 As String, Cap_GCN5 As String, Cap_GCN6 As String
Dim Cap_GCN7 As String, Cap_GCN8 As String, Cap_GCN9 As String, Cap_GCN10 As String, Cap_GCN11 As String, Cap_GCN12 As String
Dim Cap_GCN13 As String, Cap_GCN14 As String, Cap_GCN15 As String, Cap_GCN16 As String, Cap_GCN17 As String, Cap_GCN18 As String
Dim Cap_GCN19 As String, Cap_GCN20 As String, Cap_GCN21 As String, Cap_GCN22 As String, Cap_GCN23 As String, Cap_GCN24 As String
Dim Cap_GCN25 As String, Cap_GCN26 As String, Cap_GCN27 As String, Cap_GCN28 As String, Cap_GCN29 As String, Cap_GCN30 As String
Dim Cap_GCN31 As String, Cap_GCN32 As String, Cap_GCN33 As String, Cap_GCN34 As String, Cap_GCN35 As String, Cap_GCN36 As String
Dim Cap_GCN37 As String, Cap_GCN38 As String, Cap_GCN39 As String, Cap_GCN40 As String
With Sheets("DATA")
    sArr = .Range(.[A3], .[A65536].End(xlUp)).Resize(, 21).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 12)
With Sheets("BIEU")
DK = .[M5].Value: SoTrang = .[N4].Value: XemTrang = .[O4].Value
loai_DT1 = .[O11].Value: loai_DT2 = .[O12].Value: Ong = .[O8].Value: Ong2 = .[O9].Value: Ong3 = .[O10].Value
Cap_GCN1 = .[X5].Value: Cap_GCN2 = .[X6].Value: Cap_GCN3 = .[X7].Value: Cap_GCN4 = .[X8].Value: Cap_GCN5 = .[X9].Value: Cap_GCN6 = .[X10].Value
Cap_GCN7 = .[X11].Value: Cap_GCN8 = .[X12].Value: Cap_GCN9 = .[X13].Value: Cap_GCN10 = .[X14].Value: Cap_GCN11 = .[X15].Value: Cap_GCN12 = .[X16].Value
Cap_GCN13 = .[X17].Value: Cap_GCN14 = .[X18].Value: Cap_GCN15 = .[X19].Value: Cap_GCN16 = .[X20].Value: Cap_GCN17 = .[X21].Value: Cap_GCN18 = .[X22].Value
Cap_GCN19 = .[X23].Value: Cap_GCN20 = .[X24].Value: Cap_GCN21 = .[X25].Value: Cap_GCN22 = .[X26].Value: Cap_GCN23 = .[X27].Value: Cap_GCN24 = .[X28].Value
Cap_GCN25 = .[X29].Value: Cap_GCN26 = .[X30].Value: Cap_GCN27 = .[X31].Value: Cap_GCN28 = .[X32].Value: Cap_GCN29 = .[X33].Value: Cap_GCN30 = .[X34].Value
Cap_GCN31 = .[X35].Value: Cap_GCN32 = .[X36].Value: Cap_GCN33 = .[X37].Value: Cap_GCN34 = .[X38].Value: Cap_GCN35 = .[X39].Value: Cap_GCN36 = .[X40].Value
Cap_GCN37 = .[X41].Value: Cap_GCN38 = .[X42].Value: Cap_GCN39 = .[X43].Value: Cap_GCN40 = .[X44].Value

For N = 1 To UBound(sArr, 1)
    If sArr(N, 1) = DK Then
        K = K + 1
            dArr(K, 1) = sArr(N, 2)
            dArr(K, 4) = sArr(N, 4)
            dArr(K, 7) = sArr(N, 5)
            
        If sArr(N, 5) = "LUC" Then
                dArr(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "LUK" Then
                dArr(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "LUN" Then
                dArr(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "COC" Then
                dArr(K, 5) = Cap_GCN2
            ElseIf sArr(N, 5) = "BHK" Then
                dArr(K, 5) = Cap_GCN3
            ElseIf sArr(N, 5) = "NHK" Then
                dArr(K, 5) = Cap_GCN3
            ElseIf sArr(N, 5) = "LNC" Then
                dArr(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "LNQ" Then
                dArr(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "LNk" Then
                dArr(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "TSL" Then
                dArr(K, 5) = Cap_GCN5
            ElseIf sArr(N, 5) = "TSN" Then
                dArr(K, 5) = Cap_GCN5
            ElseIf sArr(N, 5) = "LMU" Then
                dArr(K, 5) = Cap_GCN6
            ElseIf sArr(N, 5) = "NKH" Then
                dArr(K, 5) = Cap_GCN7
            ElseIf sArr(N, 5) = "RSN" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RST" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RSK" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RSM" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RPN" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPT" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPK" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPM" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RDN" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDT" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDK" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDM" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "ONT" Then
                dArr(K, 5) = Cap_GCN11
            ElseIf sArr(N, 5) = "ODT" Then
                dArr(K, 5) = Cap_GCN12
            ElseIf sArr(N, 5) = "TSC" Then
                dArr(K, 5) = Cap_GCN13
            ElseIf sArr(N, 5) = "TSK" Then
                dArr(K, 5) = Cap_GCN14
            ElseIf sArr(N, 5) = "CQP" Then
                dArr(K, 5) = Cap_GCN15
            ElseIf sArr(N, 5) = "CAN" Then
                dArr(K, 5) = Cap_GCN16
            ElseIf sArr(N, 5) = "SKK" Then
                dArr(K, 5) = Cap_GCN17
            ElseIf sArr(N, 5) = "SKC" Then
                dArr(K, 5) = Cap_GCN18
            ElseIf sArr(N, 5) = "SKS" Then
                dArr(K, 5) = Cap_GCN19
            ElseIf sArr(N, 5) = "SKX" Then
                dArr(K, 5) = Cap_GCN20
            ElseIf sArr(N, 5) = "DGT" Then
                dArr(K, 5) = Cap_GCN21
            ElseIf sArr(N, 5) = "DTL" Then
                dArr(K, 5) = Cap_GCN22
            ElseIf sArr(N, 5) = "DNL" Then
                dArr(K, 5) = Cap_GCN23
            ElseIf sArr(N, 5) = "DBV" Then
                dArr(K, 5) = Cap_GCN24
            ElseIf sArr(N, 5) = "DVH" Then
                dArr(K, 5) = Cap_GCN25
            ElseIf sArr(N, 5) = "DYT" Then
                dArr(K, 5) = Cap_GCN26
            ElseIf sArr(N, 5) = "DGD" Then
                dArr(K, 5) = Cap_GCN27
            ElseIf sArr(N, 5) = "DTT" Then
                dArr(K, 5) = Cap_GCN28
            ElseIf sArr(N, 5) = "DKH" Then
                dArr(K, 5) = Cap_GCN29
            ElseIf sArr(N, 5) = "DXH" Then
                dArr(K, 5) = Cap_GCN30
            ElseIf sArr(N, 5) = "DCH" Then
                dArr(K, 5) = Cap_GCN31
            ElseIf sArr(N, 5) = "DDT" Then
                dArr(K, 5) = Cap_GCN32
            ElseIf sArr(N, 5) = "DRA" Then
                dArr(K, 5) = Cap_GCN33
            ElseIf sArr(N, 5) = "TON" Then
                dArr(K, 5) = Cap_GCN34
            ElseIf sArr(N, 5) = "TIN" Then
                dArr(K, 5) = Cap_GCN35
            ElseIf sArr(N, 5) = "NTD" Then
                dArr(K, 5) = Cap_GCN36
            ElseIf sArr(N, 5) = "SON" Then
                dArr(K, 5) = Cap_GCN37
            ElseIf sArr(N, 5) = "MNC" Then
                dArr(K, 5) = Cap_GCN38
            ElseIf sArr(N, 5) = "PNK" Then
                dArr(K, 5) = Cap_GCN39
            ElseIf sArr(N, 5) = "BCS" Then
                dArr(K, 5) = Cap_GCN40
            ElseIf sArr(N, 5) = "DCS" Then
                dArr(K, 5) = Cap_GCN40
            ElseIf sArr(N, 5) = "NCS" Then
                dArr(K, 5) = Cap_GCN40
            
            Else
                dArr(K, 5) = vbNullString
        End If
            
            If sArr(N, 6) = 1 Then
                dArr(K, 3) = loai_DT1
            ElseIf sArr(N, 6) = 2 Then
                dArr(K, 3) = loai_DT1
            ElseIf sArr(N, 6) = 3 Then
                dArr(K, 3) = loai_DT2
            ElseIf sArr(N, 6) = 4 Then
                dArr(K, 3) = loai_DT2
            ElseIf sArr(N, 6) = 5 Then
                dArr(K, 3) = loai_DT2
            Else
                dArr(K, 3) = vbNullString
        End If
                       
        If sArr(N, 6) = 1 Then
                dArr(K, 2) = Ong & sArr(N, 3)
            ElseIf sArr(N, 6) = 2 Then
                dArr(K, 2) = Ong2 & sArr(N, 3)
            ElseIf sArr(N, 6) = 3 Then
                dArr(K, 2) = Ong3 & sArr(N, 3)
            ElseIf sArr(N, 6) = 4 Then
                dArr(K, 2) = Ong3 & sArr(N, 3)
            ElseIf sArr(N, 6) = 5 Then
                dArr(K, 2) = Ong3 & sArr(N, 3)
            Else
                dArr(K, 2) = vbNullString
        End If
    End If
Next N
ReDim dArr2(1 To UBound(dArr, 1), 1 To 12)
If XemTrang <= SoTrang Then
    D = XemTrang * 39 - 38
    For I = D To K
        K1 = K1 + 1
        For J = 1 To 10
            dArr2(K1, J) = dArr(I, J)
        Next J
    Next I
End If
.[A5:L43].Value = dArr2
End With
End Sub

Public Sub BATE()
Application.EnableEvents = True
End Sub

Public Sub IN_BIEU()
UForm1.Show
End Sub
Chương trình em khai báo nhiều biến qúa để xử lý câu lệnh bời vì em chưa biết nhiều về Mảng
mọi người giúp em rút gọn bớt Code của chương trình với ạ (Chương trình nằm trong Module2)
Thanks
 
Upvote 0
Đây là Code do bác Ba Tê viết giúp em và em đã cải tiến một số phần để phục vụ công việc tuy nhiên khi xử lý Code thì em chưa có kinh nghiệm nhiều, mọi người cho em hỏi chút ạ
PHP:
Public Sub LOC_BIEU1()
..............
Chương trình em khai báo nhiều biến qúa để xử lý câu lệnh bời vì em chưa biết nhiều về Mảng
mọi người giúp em rút gọn bớt Code của chương trình với ạ (Chương trình nằm trong Module2)
Thanks


Theo mình ở đây bạn muốn nhờ người khác giúp đỡ viết code. Và thực tế bác Ba Tê đã giúp bạn làm điều đó rất nhiệt tình và tôi không nhầm thì công việc của bạn cũng đã được giải quyết. Bây giờ bạn lại muốn rút ngắn code tôi chưa hiểu ý của bạn là bạn đang muốn học VBA hay làm gì khi bạn muốn rút ngắn code.

 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Ở đây em muốn học VBA để phục vụ cho công việc của mình tuy nhiên khi xử lý chương trình của mình cho phù hợp ở Sheet(BIEU) là em có cột X là mã Loại đất và khi lấy dữ liệu bên cột MDSD Sheet(DATA) thì em phải khai báo thêm nhiều biến quá
Mã:
Cap_GCN1 = .[X5].Value: Cap_GCN2 = .[X6].Value: Cap_GCN3 = .[X7].Value: Cap_GCN4 = .[X8].Value: Cap_GCN5 = .[X9].Value: Cap_GCN6 = .[X10].Value .......

Và phải dùng nhiều lệnh If... Else... giờ em muốn các anh chị giúp là có cách nào truy xuất theo mảng để rút ngắn lài phần Code này của em không ạ
Mã:
If sArr(N, 5) = "LUC" Then
                dArr(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "LUK" Then
                dArr(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "LUN" Then
                dArr(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "COC" Then
                dArr(K, 5) = Cap_GCN2
            ElseIf sArr(N, 5) = "BHK" Then
                dArr(K, 5) = Cap_GCN3
            ElseIf sArr(N, 5) = "NHK" Then
                dArr(K, 5) = Cap_GCN3
            ElseIf sArr(N, 5) = "LNC" Then
                dArr(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "LNQ" Then
                dArr(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "LNk" Then
                dArr(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "TSL" Then
                dArr(K, 5) = Cap_GCN5
            ElseIf sArr(N, 5) = "TSN" Then
                dArr(K, 5) = Cap_GCN5
            ElseIf sArr(N, 5) = "LMU" Then
                dArr(K, 5) = Cap_GCN6
            ElseIf sArr(N, 5) = "NKH" Then
                dArr(K, 5) = Cap_GCN7
            ElseIf sArr(N, 5) = "RSN" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RST" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RSK" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RSM" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RPN" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPT" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPK" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPM" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RDN" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDT" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDK" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDM" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "ONT" Then
                dArr(K, 5) = Cap_GCN11
            ElseIf sArr(N, 5) = "ODT" Then
                dArr(K, 5) = Cap_GCN12
            ElseIf sArr(N, 5) = "TSC" Then
                dArr(K, 5) = Cap_GCN13
            ElseIf sArr(N, 5) = "TSK" Then
                dArr(K, 5) = Cap_GCN14
            ElseIf sArr(N, 5) = "CQP" Then
                dArr(K, 5) = Cap_GCN15
            ElseIf sArr(N, 5) = "CAN" Then
                dArr(K, 5) = Cap_GCN16
            ElseIf sArr(N, 5) = "SKK" Then
                dArr(K, 5) = Cap_GCN17
            ElseIf sArr(N, 5) = "SKC" Then
                dArr(K, 5) = Cap_GCN18
            ElseIf sArr(N, 5) = "SKS" Then
                dArr(K, 5) = Cap_GCN19
            ElseIf sArr(N, 5) = "SKX" Then
                dArr(K, 5) = Cap_GCN20
            ElseIf sArr(N, 5) = "DGT" Then
                dArr(K, 5) = Cap_GCN21
            ElseIf sArr(N, 5) = "DTL" Then
                dArr(K, 5) = Cap_GCN22
            ElseIf sArr(N, 5) = "DNL" Then
                dArr(K, 5) = Cap_GCN23
            ElseIf sArr(N, 5) = "DBV" Then
                dArr(K, 5) = Cap_GCN24
            ElseIf sArr(N, 5) = "DVH" Then
                dArr(K, 5) = Cap_GCN25
            ElseIf sArr(N, 5) = "DYT" Then
                dArr(K, 5) = Cap_GCN26
            ElseIf sArr(N, 5) = "DGD" Then
                dArr(K, 5) = Cap_GCN27
            ElseIf sArr(N, 5) = "DTT" Then
                dArr(K, 5) = Cap_GCN28
            ElseIf sArr(N, 5) = "DKH" Then
                dArr(K, 5) = Cap_GCN29
            ElseIf sArr(N, 5) = "DXH" Then
                dArr(K, 5) = Cap_GCN30
            ElseIf sArr(N, 5) = "DCH" Then
                dArr(K, 5) = Cap_GCN31
            ElseIf sArr(N, 5) = "DDT" Then
                dArr(K, 5) = Cap_GCN32
            ElseIf sArr(N, 5) = "DRA" Then
                dArr(K, 5) = Cap_GCN33
            ElseIf sArr(N, 5) = "TON" Then
                dArr(K, 5) = Cap_GCN34
            ElseIf sArr(N, 5) = "TIN" Then
                dArr(K, 5) = Cap_GCN35
            ElseIf sArr(N, 5) = "NTD" Then
                dArr(K, 5) = Cap_GCN36
            ElseIf sArr(N, 5) = "SON" Then
                dArr(K, 5) = Cap_GCN37
            ElseIf sArr(N, 5) = "MNC" Then
                dArr(K, 5) = Cap_GCN38
            ElseIf sArr(N, 5) = "PNK" Then
                dArr(K, 5) = Cap_GCN39
            ElseIf sArr(N, 5) = "BCS" Then
                dArr(K, 5) = Cap_GCN40
            ElseIf sArr(N, 5) = "DCS" Then
                dArr(K, 5) = Cap_GCN40
            ElseIf sArr(N, 5) = "NCS" Then
                dArr(K, 5) = Cap_GCN40
            Else
                dArr(K, 5) = vbNullString
        End If

Đây chỉ có 40 mã nếu có nhiều hơn thì sao????
huuu
nhờ mọi người giúp đỡ ạ
thanks
 
Upvote 0
xin chào anh chị..............
tôi đang mài mò học cách viết vba bằng mảng.(giải bài tập của một bạn trên diễn đàn)
nhưng khi dùng 2 vòng lặp trên 2 mảng, khi trả về sheet thì thứ tự của nó ko đúng.
anh chi nào giúp với,
yêu cầu trong file
cám ơn nhiều
 

File đính kèm

Upvote 0
xin chào anh chị..............
tôi đang mài mò học cách viết vba bằng mảng.(giải bài tập của một bạn trên diễn đàn)
nhưng khi dùng 2 vòng lặp trên 2 mảng, khi trả về sheet thì thứ tự của nó ko đúng.
anh chi nào giúp với,
yêu cầu trong file
cám ơn nhiều

Bạn thử với sub này xem:

Mã:
Sub test()    
    Dim Dic As Object
    Dim QT As Variant, KHO As Variant, KQ() As Variant
    Dim i As Long, j As Long, k As Long, n As Long
    
    Application.ScreenUpdating = False
    Set Dic = CreateObject("Scripting.Dictionary")
    KHO = Sheet3.Range(Sheet3.Range("A2"), Sheet3.Range("A65000").End(xlUp)).Resize(, 5).Value
    With Sheet1
        QT = .Range(.Range("B3"), .Range("B65000").End(xlUp)).Resize(, 3).Value
        ReDim KQ(1 To UBound(QT), 1 To 1)
        If .Range("B65000").End(xlUp).Row > 2 Then
            For i = 1 To UBound(KHO)
                If IsDate(KHO(i, 1)) And Not Dic.exists(KHO(i, 3)) Then
                    Dic.Add KHO(i, 3), ""
                End If
            Next i
            For i = 1 To UBound(QT)
                k = 0
                If Dic.exists(QT(i, 3)) Then
                    For j = 1 To UBound(KHO)
                        If KHO(j, 3) = QT(i, 3) Then
                            For n = j + 1 To UBound(KHO)
                                If Not IsDate(KHO(n, 1)) Then
                                    k = k + 1
                                    KQ(i + k, 1) = KHO(n, 5)
                                Else
                                    Exit For
                                End If
                            Next n
                        End If
                    Next j
                End If
            Next i
            .Range("F3:F65000").ClearContents
            .Range("F3").Resize(i - 1).Value = KQ
        End If
    End With
    Set Dic = Nothing
    Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn thử với sub này xem:

[/CODE]

khó thất...hihihi...........viết trực tiếp trên sheet dể hình dung hơn...............hehehe.
anh có thể giải thích thêm cái lệnh này giúp với
Mã:
Dic.Add KHO(i, 3), ""
có thể hiểu vậy được ko anh
==>Dic add, lệnh nạp vào dic
==>KHO(i, 3), là phần tử nạp
==> vậy còn "" có nghĩa là sao ạh?, thông thường tôi thấy người ta hay thêm cái lệnh k=k+1
và lệnh nạp vào dic là
Mã:
Dic.Add KHO(i, 3), k
thì tôi hiểu là qua mỗi lần lặp, k tăng lên một lần, và các phần tử được nạp nối tiếp nhau vào trong dic. còn như trường hợp anh viết thì ko biết hiểu như thế nào?
mong anh giải thích giúp

p/s: tôi học theo kiểu thợ đụng,"đụng đâu học đó", nên ko có bài bảng....hihihih
cám ơn
 
Upvote 0
Ở đây em muốn học VBA để phục vụ cho công việc của mình tuy nhiên khi xử lý chương trình của mình cho phù hợp ở Sheet(BIEU) là em có cột X là mã Loại đất và khi lấy dữ liệu bên cột MDSD Sheet(DATA) thì em phải khai báo thêm nhiều biến quá
Mã:
Cap_GCN1 = .[X5].Value: Cap_GCN2 = .[X6].Value: Cap_GCN3 = .[X7].Value: Cap_GCN4 = .[X8].Value: Cap_GCN5 = .[X9].Value: Cap_GCN6 = .[X10].Value .......

Và phải dùng nhiều lệnh If... Else... giờ em muốn các anh chị giúp là có cách nào truy xuất theo mảng để rút ngắn lài phần Code này của em không ạ
Mã:
If sArr(N, 5) = "LUC" Then
                dArr(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "LUK" Then
                dArr(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "LUN" Then
                dArr(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "COC" Then
                dArr(K, 5) = Cap_GCN2
            ElseIf sArr(N, 5) = "BHK" Then
                dArr(K, 5) = Cap_GCN3
            ElseIf sArr(N, 5) = "NHK" Then
                dArr(K, 5) = Cap_GCN3
            ElseIf sArr(N, 5) = "LNC" Then
                dArr(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "LNQ" Then
                dArr(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "LNk" Then
                dArr(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "TSL" Then
                dArr(K, 5) = Cap_GCN5
            ElseIf sArr(N, 5) = "TSN" Then
                dArr(K, 5) = Cap_GCN5
            ElseIf sArr(N, 5) = "LMU" Then
                dArr(K, 5) = Cap_GCN6
            ElseIf sArr(N, 5) = "NKH" Then
                dArr(K, 5) = Cap_GCN7
            ElseIf sArr(N, 5) = "RSN" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RST" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RSK" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RSM" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RPN" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPT" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPK" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPM" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RDN" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDT" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDK" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDM" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "ONT" Then
                dArr(K, 5) = Cap_GCN11
            ElseIf sArr(N, 5) = "ODT" Then
                dArr(K, 5) = Cap_GCN12
            ElseIf sArr(N, 5) = "TSC" Then
                dArr(K, 5) = Cap_GCN13
            ElseIf sArr(N, 5) = "TSK" Then
                dArr(K, 5) = Cap_GCN14
            ElseIf sArr(N, 5) = "CQP" Then
                dArr(K, 5) = Cap_GCN15
            ElseIf sArr(N, 5) = "CAN" Then
                dArr(K, 5) = Cap_GCN16
            ElseIf sArr(N, 5) = "SKK" Then
                dArr(K, 5) = Cap_GCN17
            ElseIf sArr(N, 5) = "SKC" Then
                dArr(K, 5) = Cap_GCN18
            ElseIf sArr(N, 5) = "SKS" Then
                dArr(K, 5) = Cap_GCN19
            ElseIf sArr(N, 5) = "SKX" Then
                dArr(K, 5) = Cap_GCN20
            ElseIf sArr(N, 5) = "DGT" Then
                dArr(K, 5) = Cap_GCN21
            ElseIf sArr(N, 5) = "DTL" Then
                dArr(K, 5) = Cap_GCN22
            ElseIf sArr(N, 5) = "DNL" Then
                dArr(K, 5) = Cap_GCN23
            ElseIf sArr(N, 5) = "DBV" Then
                dArr(K, 5) = Cap_GCN24
            ElseIf sArr(N, 5) = "DVH" Then
                dArr(K, 5) = Cap_GCN25
            ElseIf sArr(N, 5) = "DYT" Then
                dArr(K, 5) = Cap_GCN26
            ElseIf sArr(N, 5) = "DGD" Then
                dArr(K, 5) = Cap_GCN27
            ElseIf sArr(N, 5) = "DTT" Then
                dArr(K, 5) = Cap_GCN28
            ElseIf sArr(N, 5) = "DKH" Then
                dArr(K, 5) = Cap_GCN29
            ElseIf sArr(N, 5) = "DXH" Then
                dArr(K, 5) = Cap_GCN30
            ElseIf sArr(N, 5) = "DCH" Then
                dArr(K, 5) = Cap_GCN31
            ElseIf sArr(N, 5) = "DDT" Then
                dArr(K, 5) = Cap_GCN32
            ElseIf sArr(N, 5) = "DRA" Then
                dArr(K, 5) = Cap_GCN33
            ElseIf sArr(N, 5) = "TON" Then
                dArr(K, 5) = Cap_GCN34
            ElseIf sArr(N, 5) = "TIN" Then
                dArr(K, 5) = Cap_GCN35
            ElseIf sArr(N, 5) = "NTD" Then
                dArr(K, 5) = Cap_GCN36
            ElseIf sArr(N, 5) = "SON" Then
                dArr(K, 5) = Cap_GCN37
            ElseIf sArr(N, 5) = "MNC" Then
                dArr(K, 5) = Cap_GCN38
            ElseIf sArr(N, 5) = "PNK" Then
                dArr(K, 5) = Cap_GCN39
            ElseIf sArr(N, 5) = "BCS" Then
                dArr(K, 5) = Cap_GCN40
            ElseIf sArr(N, 5) = "DCS" Then
                dArr(K, 5) = Cap_GCN40
            ElseIf sArr(N, 5) = "NCS" Then
                dArr(K, 5) = Cap_GCN40
            Else
                dArr(K, 5) = vbNullString
        End If

Đây chỉ có 40 mã nếu có nhiều hơn thì sao????
huuu
nhờ mọi người giúp đỡ ạ
thanks

Đây chỉ có 40 mã nếu có nhiều hơn thì sao????
Tìm đọc tài liệu về lệnh SELECT CASE...

huuu
Không hiểu. Hỏi thì chịu khó viết cho rõ ràng. Nửa nạc nửa mỡ là thế nào?

thanks
Cái nào không có tiếng Việt thì hãy dùng ngoại lai. Tập tành thói quen lai căng thì có gì là hay.

Tổng quan: code có hằng trăm nơi dùng mã cứng (hardcode). Code này gặp bảng sửa môt tí là viết lại lộn tùng phèo hết trơn. Thảo nào nghe bà con than thở "khổ nhất là khi gặp người dùng chèn thêm cột"
 
Upvote 0
khó thất...hihihi...........viết trực tiếp trên sheet dể hình dung hơn...............hehehe.
anh có thể giải thích thêm cái lệnh này giúp với
Mã:
Dic.Add KHO(i, 3), ""
có thể hiểu vậy được ko anh
==>Dic add, lệnh nạp vào dic
==>KHO(i, 3), là phần tử nạp
==> vậy còn "" có nghĩa là sao ạh?, thông thường tôi thấy người ta hay thêm cái lệnh k=k+1
và lệnh nạp vào dic là
Mã:
Dic.Add KHO(i, 3), k
thì tôi hiểu là qua mỗi lần lặp, k tăng lên một lần, và các phần tử được nạp nối tiếp nhau vào trong dic. còn như trường hợp anh viết thì ko biết hiểu như thế nào?
mong anh giải thích giúp

p/s: tôi học theo kiểu thợ đụng,"đụng đâu học đó", nên ko có bài bảng....hihihih
cám ơn

Add là "thêm vào". Ta thêm 1 key và 1 item tương ứng với nó. Tức thêm vào 1 cặp (key, item). Người ta không cần item (trong phần tiếp theo của code) nên người ta nhập item = "" (chuỗi rỗng). Người khác cần trong phần tiếp theo thì nhập item = k (số)

Nhiều khi bạn có một loạt tương quan "key - item" và khi có 1 key (từ khóa) nào đó bạn muốn đọc ra item tương ứng với nó. Lúc đó thì khi gọi Add bạn phải nhập key và item tương ứng với nó.

Giả sử bạn có dữ liệu từ điển ở dạng tập tin txt: có 10000 dòng, mỗi dòng có cấu trúc vd. [từ]TAB[nghĩa của từ]. Vd. loveTABtình yêu (TAB là ký tự có code = 9 - phím TAB)

Bây giờ code của bạn đọc vào: UserForm có 1 ListBox hiển thị các từ, và nếu chọn từ nào thì sẽ hiển thị nghĩa tiếng Việt của từ đó trong TextBox. Bạn làm thế nào. Giả sử bạn muốn dùng "đít thon". Thế thì khi Add bạn không chỉ chỉ ra "từ - key - từ khóa" mà phải chỉ ra cả "item - nghĩa của từ" nữa. Vậy thì bạn đọc tập tin txt --> tách mỗi dòng thành [từ] và [nghĩa] --> dic.Add [từ], [nghĩa] --> thêm từ vào ListBox.
Khi người ta chọn trong ListBox thì bạn đọc ra được [từ] --> bạn dùng dic.item("key") để đọc ra item là nghĩa để "nhồi" vào TextBox.

Ngoài việc làm từ điển thì bạn cũng có thể làm vd. "sách nấu ăn": key = tên món ăn", item = nguyên liệu, cách nấu. Sổ điện thoại: key = họ tên, item = địa chỉ, số dđ v...v

Chính vì để lưu trữ key (từ khóa) - item (giá trị), cấu trúc như từ điển mà "nó" có tên là Dictionary.
 
Upvote 0
Add là "thêm vào". Ta thêm 1 key và 1 item tương ứng với nó. Tức thêm vào 1 cặp (key, item). Người ta không cần item (trong phần tiếp theo của code) nên người ta nhập item = "" (chuỗi rỗng). Người khác cần trong phần tiếp theo thì nhập item = k (số)

Nhiều khi bạn có một loạt tương quan "key - item" và khi có 1 key (từ khóa) nào đó bạn muốn đọc ra item tương ứng với nó. Lúc đó thì khi gọi Add bạn phải nhập key và item tương ứng với nó.

Giả sử bạn có dữ liệu từ điển ở dạng tập tin txt: có 10000 dòng, mỗi dòng có cấu trúc vd. [từ]TAB[nghĩa của từ]. Vd. loveTABtình yêu (TAB là ký tự có code = 9 - phím TAB)

Bây giờ code của bạn đọc vào: UserForm có 1 ListBox hiển thị các từ, và nếu chọn từ nào thì sẽ hiển thị nghĩa tiếng Việt của từ đó trong TextBox. Bạn làm thế nào. Giả sử bạn muốn dùng "đít thon". Thế thì khi Add bạn không chỉ chỉ ra "từ - key - từ khóa" mà phải chỉ ra cả "item - nghĩa của từ" nữa. Vậy thì bạn đọc tập tin txt --> tách mỗi dòng thành [từ] và [nghĩa] --> dic.Add [từ], [nghĩa] --> thêm từ vào ListBox.
Khi người ta chọn trong ListBox thì bạn đọc ra được [từ] --> bạn dùng dic.item("key") để đọc ra item là nghĩa để "nhồi" vào TextBox.

Ngoài việc làm từ điển thì bạn cũng có thể làm vd. "sách nấu ăn": key = tên món ăn", item = nguyên liệu, cách nấu. Sổ điện thoại: key = họ tên, item = địa chỉ, số dđ v...v

Chính vì để lưu trữ key (từ khóa) - item (giá trị), cấu trúc như từ điển mà "nó" có tên là Dictionary.

cám ơn anh nhiều, để "tiêu hóa" được những điều anh giải thích, chắc là còn một quảng đường rất dài phía trước....@!##
 
Upvote 0
khó thất...hihihi...........viết trực tiếp trên sheet dể hình dung hơn...............hehehe.
anh có thể giải thích thêm cái lệnh này giúp với
Mã:
Dic.Add KHO(i, 3), ""
có thể hiểu vậy được ko anh
==>Dic add, lệnh nạp vào dic
==>KHO(i, 3), là phần tử nạp
==> vậy còn "" có nghĩa là sao ạh?, thông thường tôi thấy người ta hay thêm cái lệnh k=k+1
và lệnh nạp vào dic là
Mã:
Dic.Add KHO(i, 3), k
thì tôi hiểu là qua mỗi lần lặp, k tăng lên một lần, và các phần tử được nạp nối tiếp nhau vào trong dic. còn như trường hợp anh viết thì ko biết hiểu như thế nào?
mong anh giải thích giúp

p/s: tôi học theo kiểu thợ đụng,"đụng đâu học đó", nên ko có bài bảng....hihihih
cám ơn

Hãy tưởng tưởng 1 bảng tra cứu dùng cho hàm VLOOKUP gồm có 2 cột. Vậy cột đầu tiên đương nhiên là từ khóa để tra (Với dic thì nó là Key). Cột thứ 2 là giá trị cần tra cứu
Khi bạn dùng VLOOUP thì cái bảng tra ấy có sẵn, còn với Dictionary, hãy tưởng tượng rằng bảng tra ấy chưa có và ta đang xây dựng nó bằng cách nạp Dic vào 2 cột
Cú pháp nạp Dictionary là: Dic.Add Key, Item
Theo quy định của Dic thì Key không cho phép trùng, còn Item thì là cái giống gì cũng được.
Mỗi lần bạn nạp Dic thì Key là bắt buộc phải có còn Item là tùy ý. Nếu bạn không muốn dùng Item vào việc gì sau này thì cứ cho nó = ""
Sau khi đã náp xong Dic, xem như đã có bảng tra thì ta có thể truy xuất nó gần giống như hàm VLOOKUP: Dic.Item(Key) với Key là từ khóa để tra và kết quả tra về là Item tương ứng với Key (lúc trước ta đã nạp 1 cặp)
Vậy, nếu cần Item thì nạp vào, sau này có thể truy xuất ra để xài, không cần thì khỏi nạp (cho nó = ""), và khi ấy ta dùng Dic như 1 dạng bài toán lọc duy nhất mà thôi
 
Lần chỉnh sửa cuối:
Upvote 0
Các bác có cách nào giúp em: Viết 1 hàm Excel để nó làm các công việc sau: Copy rồi Paste-Special-Value và Save file theo 1 khoảng thời gian chọn trước.



Ví dụ cụ thể: Ở ô C1 ta có hàm Pastevalue(A$1,$B$1) là làm việc sau: Nếu điều kiện A$1 thoả mãn thì copy ô $B$1 rồi paste-special-value vào ô C1 rồi save file. A$1 là 1 điều kiện thời gian (như 15-23 giờ ngày 21/2/2014 chẳng hạn), nếu hiện tại trước thời điểm này thì giá trị ở C1 = 0, sau thời điểm này thì hiển thị giá trị đã có lúc hàm chạy khi điều kiện thời gia A$1 thoả mãn.

Qua ô C2 ta có hàm Pastevalue(A$2,$B$1) và chạy tương tự.

Lưu ý rằng: Giá trị của B1 là thay đổi theo từng ngày nên cái mình cần ở C1, C2,... là giá trị cố định của $B$1 tại 1 thời điểm xác định trước thể hiện ở A1, A2,...




Mỗi khi mở file thì hàm tự động chạy hoặc nếu file đang mở rồi thì đến thời gian chọn trước hàm tự động chạy 1 lần!

Em cần hàm này vì e lấy data bảng giá chứng khoán từ web về và muốn nó lưu lại 1 số mã từng ngày để xử lý.

(em chưa biết j về macro, VBA,.. nên muốn biến những cái này thành hàm để xử lý cho đơn giản)
 
Lần chỉnh sửa cuối:
Upvote 0
Viết hàm căn bậc 3 trong vba

Em thử viết (-2) ^ (1/3) trong vba , nhưng đều báo lỗi, Vậy nếu em muốn tính căn bậc 3 của (-2) thì phải viết như thế nào !?
 
Upvote 0
Ừ hen! Giờ mới chú í chuyện này;
Trong cửa sổ trung gian thì được;
Còn trong VBA tạm thời có cách đi đường vòng:
PHP:
Function Can3(Num As Double) As Double
 If Num >= 0 Then
    Can3 = Num ^ (1 / 3)
 Else
    Can3 = -Abs(Num) ^ (1 / 3)
 End If
End Function
 
Upvote 0
Ừ hen! Giờ mới chú í chuyện này;
Trong cửa sổ trung gian thì được;
Còn trong VBA tạm thời có cách đi đường vòng:
PHP:
Function Can3(Num As Double) As Double
 If Num >= 0 Then
    Can3 = Num ^ (1 / 3)
 Else
    Can3 = -Abs(Num) ^ (1 / 3)
 End If
End Function
theo mình hiểu thì điều kiện để phép tính a^b có nghĩa là a > = 0
dó đó cách viết (-x) ^ (1/3) sẽ không có nghĩa, ta chỉ có thể viết -x ^ (1/3)
 
Upvote 0
Thưa ad, em đã gán macro vào nút như hình vẽ, vậy trong VBA có lệnh nào để di chuyển nút đó đến 1 ô (hoặc tọa độ) mình mong muốn không ạ? Ví dụ như chuyển nó xuống cell có chữ "Nhóm 1" chẳng hạn.
Mong ad giải đáp giùm em, em xin cảm ơn.
 

File đính kèm

  • Capture.jpg
    Capture.jpg
    35.5 KB · Đọc: 45
Lần chỉnh sửa cuối:
Upvote 0
Thưa ad, em đã gán macro vào nút như hình vẽ, vậy trong VBA có lệnh nào để di chuyển nút đó đến 1 ô (hoặc tọa độ) mình mong muốn không ạ? Ví dụ như chuyển nó xuống cell có chữ "Nhóm 1" chẳng hạn.
Mong ad giải đáp giùm em, em xin cảm ơn.
Giả sử cái nút của bạn có tên shp và ô bạn muốn di chuyển là A5 thì đoạn code thực hiện theo yêu cầu là
Mã:
ActiveSheet.Shapes("Shp").Left = [A5].Left
ActiveSheet.Shapes("Shp").Top = [A5].Top
 
Upvote 0
Bảng excel mình có nhiều giá trị cần ấn f2 rùi enter mới hiện giá trị. mà làm thủ công mất thời gian quá. Mình muốn một đoạn VBA làm mới giá trị trong excell, như ấn f2 rùi ấn enter
Do mới học VBA nên chưa biết nhiều nhờ các bác chỉ giúp.
 
Upvote 0
Bảng excel mình có nhiều giá trị cần ấn f2 rùi enter mới hiện giá trị. mà làm thủ công mất thời gian quá. Mình muốn một đoạn VBA làm mới giá trị trong excell, như ấn f2 rùi ấn enter
Do mới học VBA nên chưa biết nhiều nhờ các bác chỉ giúp.
Thử với cái này xem:

Mã:
Sub AllRefresh()
    ActiveWorkbook.RefreshAll
End Sub
 
Upvote 0
Thưa ad, em đã gán macro vào nút như hình vẽ, vậy trong VBA có lệnh nào để di chuyển nút đó đến 1 ô (hoặc tọa độ) mình mong muốn không ạ? Ví dụ như chuyển nó xuống cell có chữ "Nhóm 1" chẳng hạn.
Mong ad giải đáp giùm em, em xin cảm ơn.
Mã:
Sub GPE()
    Dim cmdButton As OLEObject, rng As Range
        Set rng = Application.InputBox("Nhap dia chi Cell", , , , , , , 8)
        Set cmdButton = ActiveSheet.OLEObjects _
                        ([COLOR=#ff0000][B]" TEN CUA COMMAND BUTTON "[/B][/COLOR])
        With cmdButton
            .Left = rng.Left
            .Top = rng.Top
            rng.RowHeight = .Height
        End With
End Sub
 
Upvote 0
Giả sử cái nút của bạn có tên shp và ô bạn muốn di chuyển là A5 thì đoạn code thực hiện theo yêu cầu là
Mã:
ActiveSheet.Shapes("Shp").Left = [A5].Left
ActiveSheet.Shapes("Shp").Top = [A5].Top
Cho em hỏi làm sao để biết tên của shape ạ? Em mò thử cũng chỉ thấy tên của Macro gán vào thôi.
 
Upvote 0
Mã:
Sub GPE()
    Dim cmdButton As OLEObject, rng As Range
        Set rng = Application.InputBox("Nhap dia chi Cell", , , , , , , 8)
        Set cmdButton = ActiveSheet.OLEObjects _
                        ([COLOR=#ff0000][B]" TEN CUA COMMAND BUTTON "[/B][/COLOR])
        With cmdButton
            .Left = rng.Left
            .Top = rng.Top
            rng.RowHeight = .Height
        End With
End Sub
Thưa anh, em đã tạo 1 button như hình vẽ, nhưng khi chạy thử thì bị lỗi "Unable to get the OLEObjects property of the worksheet class", tại sao lại như vậy ạ? Hay do em nhập tên button sai? Em nhập tên Button là cái tên hiện ra trên button khi mới tạo luôn .
 

File đính kèm

  • Capture.jpg
    Capture.jpg
    37.3 KB · Đọc: 31
Upvote 0
Thưa anh, em đã tạo 1 button như hình vẽ, nhưng khi chạy thử thì bị lỗi "Unable to get the OLEObjects property of the worksheet class", tại sao lại như vậy ạ? Hay do em nhập tên button sai? Em nhập tên Button là cái tên hiện ra trên button khi mới tạo luôn .

Điều này có nghĩa là: Bạn phải đưa file + code lên đây thì người ta mới biết, đúng không nào?
 
Upvote 0

Bài viết mới nhất

Back
Top Bottom