Chuyên đề giải đáp những thắc mắc về code VBA (3 người xem)

Liên hệ QC

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

Đang trực tuyến: 3 (Thành viên: 0, Khách: 3)
maytinhvp01

maytinhvp01

Thành viên thường trực
Tham gia
27/7/13
Bài viết
390
Được thích
179
Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631
[/INFO1]
 
Chỉnh sửa lần cuối bởi điều hành viên:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Mình mới tập học VBA, có đoạn sub như này:

Sub testlap()
Dim i As Integer
Dim n, m As Integer
Dim Dir As String
Dim MyPath As String
Dim bc As String


Application.ScreenUpdating = False


Dir = Application.ActiveWorkbook.Path & ""

For i = 1 To 10
bc = "BC" & i & ".xls"
MyPath = Dir & bc

Workbooks.Open MyPath


Application.Goto Workbooks("Tong hop.xlsm").Worksheets("KetQua").Range("B7")
Range(Selection, Selection.End(xlDown)).Select
m = Selection.Count
If m = 2 Then
m = 0
Else
m = Selection.Count
End If


Application.Goto Workbooks(bc).Worksheets("KQ").Range("B1")
Range(Selection, Selection.End(xlDown)).Select
n = Selection.Count
Workbooks(bc).Worksheets("KQ").Range(Cells(2, 2), Cells(n, 13)).Copy Destination:=Workbooks("Tong hop.xlsm").Worksheets("KetQua").Cells(m + 9, 2)
Application.Goto Workbooks("Tong hop.xlsm").Worksheets("KeHoach").Range("B7")
Range(Selection, Selection.End(xlDown)).Select
m = Selection.Count
If m = 2 Then
m = 0
Else
m = Selection.Count
End If
Application.Goto Workbooks(bc).Worksheets("KH").Range("B1")
Range(Selection, Selection.End(xlDown)).Select
n = Selection.Count
Workbooks(bc).Worksheets("KH").Range(Cells(2, 2), Cells(n, 13)).Copy Destination:=Workbooks("Tong hop.xlsm").Worksheets("KeHoach").Cells(m + 9, 2)
Workbooks(bc).Close
Next


End Sub


Mình muốn copy dữ liệu trong 2 sheet KQ và KH từ các file riêng lẻ BC1.xls, BC2.xls...., BC10.xls vào 2 sheet tương ứng "KetQua" và "KeHoch" trong file "Tong hop.xlsm",
Nhưng như mình test thử thì giá trị m của mình luôn =2 với mọi i, làm cho dữ liệu paste vào file Tong hop luôn bắt đầu từ ô B9, mà mình muốn dữ liệu file BC1.xls bắt đầu dán vào ô B9, xong dữ liệu từ BC2.xls dán vào dòng tiếp theo dữ liệu đã có từ BC1.xls.
Mình không hiểu tại sao m lại luôn =2, mong mọi người giúp với ạ.

View attachment Tong hop.xlsm
View attachment BC1.xls
 

File đính kèm

  • BC1.jpg
    BC1.jpg
    50 KB · Đọc: 6
  • KQ.jpg
    KQ.jpg
    51 KB · Đọc: 5
Lần chỉnh sửa cuối:
Upvote 0
em có 1 file excel như file đính kèm, mục đích là em muốn đếm số dòng CÓ SỐ ở cột F của mỗi sheet (không đếm dòng có chữ) và tổng hợp theo tên của sheet để cho ra kết quả như sheet tổng hợp, em có khoảng 20 sheet, mỗi sheet có thể có đến 1000 dòng, mọi người giúp em với ạ, hoặc mọi người làm giúp em code để copy cột F ở sheet 1 -> cột A ở sheet TongHop, tương tự cột F ở quý 2 -> cột B ở sheet TongHop,.....rồi em tự count cũng được ạ, cảm ơn mọi người. Em có coi những bài tổng hợp sheet cũ nhưng không có cái nào áp dụng được như mục đích.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Nhờ các anh chị trên diễn đàn giải nghĩa đoạn Code sau với ạ

Function FileNameList(FolPath As String)
On Error Resume Next
FolPath = FolPath & ""
ActiveWorkbook.Names.Add "Arr", "=""" & FolPath & """&Files(""" & FolPath & "*.xls"")"
FileNameList = Evaluate("Arr")
ActiveWorkbook.Names("Arr").Delete
End Function
 
Upvote 0
ku_ri đã viết:
em có 1 file excel như file đính kèm, mục đích là em muốn đếm số dòng CÓ SỐ ở cột F của mỗi sheet (không đếm dòng có chữ) và tổng hợp theo tên của sheet để cho ra kết quả như sheet tổng hợp, em có khoảng 20 sheet, mỗi sheet có thể có đến 1000 dòng, mọi người giúp em với ạ, hoặc mọi người làm giúp em code để copy cột F ở sheet 1 -> cột A ở sheet TongHop, tương tự cột F ở quý 2 -> cột B ở sheet TongHop,.....rồi em tự count cũng được ạ, cảm ơn mọi người. Em có coi những bài tổng hợp sheet cũ nhưng không có cái nào áp dụng được như mục đích.
Nhấp chuột vào đây để mở rộng...
bạn chạy thử code
Mã: 
Sub DemSo()
Dim Darr(), Arr(), i As Long, k As Integer, s As Integer
ReDim Arr(1 To Sheets.Count, 1 To 2)
For s = 1 To Sheets.Count
    If Sheets(s).Name = "TongHop" Then GoTo tiep
    k = k + 1:  Arr(k, 1) = Sheets(s).Name: Arr(k, 2) = 0
    If Sheets(s).Range("F65500").End(xlUp).Row < 3 Then GoTo tiep
    Darr = Sheets(s).Range("F3:F" & Sheets(s).Range("F65500").End(xlUp).Row).Value
    For i = 1 To UBound(Darr)
        If IsNumeric(Darr(i, 1)) And Darr(i, 1) <> "" Then Arr(k, 2) = Arr(k, 2) + 1
    Next i
tiep:
Next s
Sheets("TongHop").Range("B4:C1000").ClearContents
Sheets("TongHop").Range("B4").Resize(k, 2) = Arr
End Sub
 
Upvote 0
HieuCD đã viết:
bạn chạy thử code
Mã: 
Sub DemSo()
Dim Darr(), Arr(), i As Long, k As Integer, s As Integer
ReDim Arr(1 To Sheets.Count, 1 To 2)
For s = 1 To Sheets.Count
    If Sheets(s).Name = "TongHop" Then GoTo tiep
    k = k + 1:  Arr(k, 1) = Sheets(s).Name: Arr(k, 2) = 0
    If Sheets(s).Range("F65500").End(xlUp).Row < 3 Then GoTo tiep
    Darr = Sheets(s).Range("F3:F" & Sheets(s).Range("F65500").End(xlUp).Row).Value
    For i = 1 To UBound(Darr)
        If IsNumeric(Darr(i, 1)) And Darr(i, 1) <> "" Then Arr(k, 2) = Arr(k, 2) + 1
    Next i
tiep:
Next s
Sheets("TongHop").Range("B4:C1000").ClearContents
Sheets("TongHop").Range("B4").Resize(k, 2) = Arr
End Sub
Nhấp chuột vào đây để mở rộng...
Em đã chạy thử và thành công, cảm ơn bác nhiều nhé :D
 
Upvote 0
Em chào các anh.
Em muốn bỏ lọc và fomat dữ liệu ở tất cả các sheet thì code như thế nào ạ. Em cảm ơn mọi người.
 
Upvote 0
Em chào cả nhà. Hiện em đang mới học VBA em nhờ code giúp em file đính kèm.
Em muốn viết code tự động dò danh mục kho mà chưa biết chính xác dữ liệu có bao nhiêu dòng.
Và nếu như bị NA thìbáo lỗi bằng MsgBox nội dung" Thiếu DM17 " và kết thúc Sub luôn lập tức. Em cảm ơn.
 

File đính kèm

Upvote 0
minhtuan91 đã viết:
Em chào cả nhà. Hiện em đang mới học VBA em nhờ code giúp em file đính kèm.
Em muốn viết code tự động dò danh mục kho mà chưa biết chính xác dữ liệu có bao nhiêu dòng.
Và nếu như bị NA thìbáo lỗi bằng MsgBox nội dung" Thiếu DM17 " và kết thúc Sub luôn lập tức. Em cảm ơn.
Nhấp chuột vào đây để mở rộng...
Bạn xem file đính kèm.
 

File đính kèm

Upvote 0
minhtuan91 đã viết:
Em muốn code như sau:
Ô c5 chạy công thức +VLOOKUP(B5;DM!A:B;2;0)
Sau đó tự động chạy Công thức ở cột C nhưng nếu bị NA thì báo lỗi và dừng sub lại
Nhấp chuột vào đây để mở rộng...

Cũng muốn cố giúp bạn nhưng không hiểu được bạn muốn gì...
Chạy công thức ở cột C là chạy như nào?
Công thức ở cột C sau khi nhập xong nếu có lỗi thì nó báo lỗi cho mình biết luôn rồi.
Dừng sub? yêu cầu cái sub đó thực hiện gì để dừng nó khi gặp #N/A ở cột C.
Ngoài ra, bạn không nên viết VLOOKUP(B5;DM!A:B;2;0) vùng tìm kiếm cả cột như thế, máy tính sẽ không kham nổi. Dữ liệu tới đâu thì chọn tới vùng đó thôi
Mã: 
=VLOOKUP(B5,DM!$A$4:$B$9,2,0)
 
Upvote 0
Em cảm ơn bác Befaint nhé. Em theo Code của bác để vận dụng vào file của em đã ok rồi.
 
Upvote 0
mọi người xem giúp mình file đính kèm
cho mình hỏi lý do vì sao khi show form lên rồi thao tác kéo qua lại 1 chút, sau đó đóng form đi
tắt excel => treo
vì sao lại bị treo như thế, có thể giúp mình khắc phục được không
link file
 
Upvote 0
langtuchungtinh360 đã viết:
mọi người xem giúp mình file đính kèm
cho mình hỏi lý do vì sao khi show form lên rồi thao tác kéo qua lại 1 chút, sau đó đóng form đi
tắt excel => treo
vì sao lại bị treo như thế, có thể giúp mình khắc phục được không
link file
Nhấp chuột vào đây để mở rộng...

Thêm code này vào UserForm thử xem:
Mã: 
Private Sub UserForm_Terminate()
  End
End Sub
 
Upvote 0
ndu96081631 đã viết:
Thêm code này vào UserForm thử xem:
Mã: 
Private Sub UserForm_Terminate()
  End
End Sub
Nhấp chuột vào đây để mở rộng...
oh, được rồi thầy ạ, em cảm ơn thầy. mà code đó dài quá. còn code nào tương tự vậy mà ngắn hơn không thầy. nếu áp dụng vô file em viết thì nó cả núi code trong đó luôn. nhìn ngán chết
 
Upvote 0
Xin chào các Anh chị trong diễn đàn. cho e hỏi chút ạ:
- E bôi đen 1 vùng và muốn đếm xem vùng đó có bao nhiêu dòng thì dùng đoạn code như nào vậy ạ ! (CHẳng hạn bôi đen vùng [A1:C5] thì là 5 dòng ạ )
 
Upvote 0
keke355992 đã viết:
Xin chào các Anh chị trong diễn đàn. cho e hỏi chút ạ:
- E bôi đen 1 vùng và muốn đếm xem vùng đó có bao nhiêu dòng thì dùng đoạn code như nào vậy ạ ! (CHẳng hạn bôi đen vùng [A1:C5] thì là 5 dòng ạ )
Nhấp chuột vào đây để mở rộng...

Selection.Rows.Count là số dòng của vùng được chọn. Hiện ra bằng cách nào thì tùy bạn
 
Upvote 0
Mình có sửa lại code để lấy tên file không kèm phần mở rộng, và lấy phần mở rộng của file. Mà sao nó chỉ hiển thị mỗi 1 vài folder còn các folder khác không hiện được tên file và ext ? nhờ sửa giúp
với các bác sửa giúp em hàm replace để lấy tên folder mẹ của file luôn, thanks (ko lấy full đường dẫn)
-0-/.
Làm thế nào thêm điều kiện chỉ tìm file có ext do mình chọn (VD như *.csv) và có kiểu số chằng hạn (VD file có tên 10.235.235.csv)
 

File đính kèm

Upvote 0

File đính kèm

Upvote 0
PHP: 
Sub TinhThoiGian()
 Dim Arr() As Variant
 
 Dim Rws As Long, J As Long, i As Long, lr As Long, Tmr As Double, tR1 As Double, tR2 As Double
 Dim Sht As String, Wh As String
 
With Sheets("T&T"):                             Tmr = Timer()
  
  'Dinh dang
  
  lr = .[c65000].End(3).Row
 .Range(Cells(lr + 1, 1), Cells(lr + 3000, 45)).Clear
 
 .Range(Cells(1, 8), Cells(lr, 9)).Select
 Selection.Replace What:="(+1)", Replacement:=""
  
  Sheets("T&T").Range("A9:AS9").Copy
With Sheets("T&T").Range(Cells(9, 1), Cells(lr, 45))
    .PasteSpecial Paste:=xlPasteFormats
   
    
End With
 Rws = [b9].CurrentRegion.Rows.Count - 8
 Arr() = [F9].Resize(Rws, 8).Value
 ReDim dArr(1 To Rws, 1 To 3)
 ReDim a1Arr(1 To Rws, 1 To 1)

Code trên em viết theo cách record macro nên nó hơi "nông dân". Anh chị có thể chỉ em cách viết khác mà vẫn giữ được tác dung của nó không?

Ngoài ra em muốn hỏi code sau:

PHP: 
Option Explicit
Sub LuaChon1Trong2TrangTinh()
 Dim Wh As String, ShName As String

 Wh = InputBox("A- Cong Doan A" & Chr(10) & "B- Cong Doan Hoàn Tát", "GPE.COM Xin Chào!")
 If Wh < "A" And Wh > "B" Then
    MsgBox "Tam Biet!":         Exit Sub
 End If
 ShName = Choose(Asc(UCase(Wh)) - 64, "CD_A", "HT", "GPE.COM")
 MsgBox ShName
End Sub

Như anh chị biết code đầu tiên chỉ làm việc với sheet đã chỉ danh, bây giờ em muốn thay bằng sheet nhập trong Inputbox thì làm thế nào ạ? Không phải em ngại tìm tòi mà tìm tòi không ra, em mong anh chị thông cảm đừng nghĩ em ỉ lại ạ.

Cảm ơn anh chị rất nhiều!
 
Lần chỉnh sửa cuối:
Upvote 0
tueyennhi đã viết:
PHP: 
Sub TinhThoiGian()
 Dim Arr() As Variant
 
 Dim Rws As Long, J As Long, i As Long, lr As Long, Tmr As Double, tR1 As Double, tR2 As Double
 Dim Sht As String, Wh As String
 
With Sheets("T&T"):                             Tmr = Timer()
  
  'Dinh dang
  
  lr = .[c65000].End(3).Row
 .Range(Cells(lr + 1, 1), Cells(lr + 3000, 45)).Clear
 
 .Range(Cells(1, 8), Cells(lr, 9)).Select
 Selection.Replace What:="(+1)", Replacement:=""
  
  Sheets("T&T").Range("A9:AS9").Copy
With Sheets("T&T").Range(Cells(9, 1), Cells(lr, 45))
    .PasteSpecial Paste:=xlPasteFormats
   
    
End With
 Rws = [b9].CurrentRegion.Rows.Count - 8
 Arr() = [F9].Resize(Rws, 8).Value
 ReDim dArr(1 To Rws, 1 To 3)
 ReDim a1Arr(1 To Rws, 1 To 1)

Code trên em viết theo cách record macro nên nó hơi "nông dân". Anh chị có thể chỉ em cách viết khác mà vẫn giữ được tác dung của nó không?

Ngoài ra em muốn hỏi code sau:

PHP: 
Option Explicit
Sub LuaChon1Trong2TrangTinh()
 Dim Wh As String, ShName As String

 Wh = InputBox("A- Cong Doan A" & Chr(10) & "B- Cong Doan Hoàn Tát", "GPE.COM Xin Chào!")
 If Wh < "A" And Wh > "B" Then
    MsgBox "Tam Biet!":         Exit Sub
 End If
 ShName = Choose(Asc(UCase(Wh)) - 64, "CD_A", "HT", "GPE.COM")
 MsgBox ShName
End Sub

Như anh chị biết code đầu tiên chỉ làm việc với sheet đã chỉ danh, bây giờ em muốn thay bằng sheet nhập trong Inputbox thì làm thế nào ạ? Không phải em ngại tìm tòi mà tìm tòi không ra, em mong anh chị thông cảm đừng nghĩ em ỉ lại ạ.

Cảm ơn anh chị rất nhiều!
Nhấp chuột vào đây để mở rộng...
1> Câu 1: Cố gắng bỏ hết mấy chỗ Select, Selection đi là gọn và nhanh hơn rồi
2> Chắc là vầy:
Mã: 
Function SheetExists(ByVal SheetName As String) As Boolean
  On Error Resume Next
  SheetExists = Not Sheets(SheetName) Is Nothing
End Function
Sub LuaChon1Trong2TrangTinh()
  Dim SheetName As String
  SheetName = [COLOR=#ff0000]InputBox[/COLOR]("Go tên sheet vào", "CHON SHEET")
  If SheetExists(SheetName) Then
    MsgBox SheetName
  End If
End Sub
- Thêm hàm SheetExists vào để kiểm tra, nếu bạn gõ tên sheet đang tồn tại thì làm tiếp
- Bạn dùng InputBox (chỗ màu đỏ) sẽ xuất hiện 1 lỗi nghiêm trọng: LÀM SAO BẠN GÕ ĐƯỢC TIẾNG VIỆT CÓ DẤU?. Vậy nên theo tôi nên dùng Application.InputBox (chứ không phải là InputBox)
Sửa lại:
Mã: 
Sub LuaChon1Trong2TrangTinh()
  Dim SheetName As String
  SheetName = [COLOR=#ff0000]Application.InputBox[/COLOR]("Go tên sheet vào", "CHON SHEET"[COLOR=#ff0000], Type:=2[/COLOR])
  If SheetExists(SheetName) Then
    MsgBox SheetName
  End If
End Sub
(để ý cái chỗ Type:=2 nhé)
-------------------------------
Nhân nói đến chuyện làm sao gõ được tiếng Việt có dấu, vậy cũng nên nghĩ thêm làm sao hiện được MsgBox tiếng Việt có dấu bạn nhỉ (vấn đề này có thể tham khảo trên GPE, có đầy)
Ngoài ra tôi nghĩ đi nghĩ lại vấn thấy cái InputBox có vấn đề. Sao phải gõ tên sheet? Nếu tên sheet quá dài và workbook chứa rất nhiều sheets, liệu bạn có nhớ và gõ chính xác không? Tại sao không nghĩ đến việc chọn sheet bằng ComboBox, ListBox gì gì đó cho khỏe thân?
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Tại sao không nghĩ đến việc chọn sheet bằng ComboBox, ListBox gì gì đó cho khỏe thân?
Nhấp chuột vào đây để mở rộng...

em thấy làm tới combobox vẫn chưa khỏe ? trước khi mở ra 1 inputbox ra tạo ra 1 menu đại loại như
1 : "tên sheet 1"
2 : "tên sheet 2"
3 : "tên sheet 3"
gắn chuỗi đó vào thông điệp inputbox , người ta ghi số 2 có nghĩa là muốn chọn sheet tên là "tên sheet 2" , là xong . hễ có gì sai sót mong anh chỉ điểm giúp --=0--=0
 
Upvote 0
Cảm ơn thầy ndu, em làm được rồi :)
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
1> Câu 1: Cố gắng bỏ hết mấy chỗ Select, Selection đi là gọn và nhanh hơn rồi
2> Chắc là vầy:
Mã: 
Function SheetExists(ByVal SheetName As String) As Boolean
  On Error Resume Next
  SheetExists = Not Sheets(SheetName) Is Nothing
End Function
Sub LuaChon1Trong2TrangTinh()
  Dim SheetName As String
  SheetName = [COLOR=#ff0000]InputBox[/COLOR]("Go tên sheet vào", "CHON SHEET")
  If SheetExists(SheetName) Then
    MsgBox SheetName
  End If
End Sub
- Thêm hàm SheetExists vào để kiểm tra, nếu bạn gõ tên sheet đang tồn tại thì làm tiếp
- Bạn dùng InputBox (chỗ màu đỏ) sẽ xuất hiện 1 lỗi nghiêm trọng: LÀM SAO BẠN GÕ ĐƯỢC TIẾNG VIỆT CÓ DẤU?. Vậy nên theo tôi nên dùng Application.InputBox (chứ không phải là InputBox)
Sửa lại:
Mã: 
Sub LuaChon1Trong2TrangTinh()
  Dim SheetName As String
  SheetName = [COLOR=#ff0000]Application.InputBox[/COLOR]("Go tên sheet vào", "CHON SHEET"[COLOR=#ff0000], Type:=2[/COLOR])
  If SheetExists(SheetName) Then
    MsgBox SheetName
  End If
End Sub
(để ý cái chỗ Type:=2 nhé)
-------------------------------
Nhân nói đến chuyện làm sao gõ được tiếng Việt có dấu, vậy cũng nên nghĩ thêm làm sao hiện được MsgBox tiếng Việt có dấu bạn nhỉ (vấn đề này có thể tham khảo trên GPE, có đầy)
Ngoài ra tôi nghĩ đi nghĩ lại vấn thấy cái InputBox có vấn đề. Sao phải gõ tên sheet? Nếu tên sheet quá dài và workbook chứa rất nhiều sheets, liệu bạn có nhớ và gõ chính xác không? Tại sao không nghĩ đến việc chọn sheet bằng ComboBox, ListBox gì gì đó cho khỏe thân?
Nhấp chuột vào đây để mở rộng...

Thầy cho em hỏi em làm như hướng dẫn nhưng đang không chạy theo ý em. Mặc dù nhập sheet để tính nhưng mà nếu mình chạy code ở sheet nào thì nó tính sheet ấy chứ không theo sheet mình nhập vào Inputbox. Không biết em nhầm lẫn ở đâu. Theo em hiểu thì thật ra code đang chạy trên sheet đang active.

PHP: 
Sub Cong_ngay_le_ngaynghi()
 Dim Arr() As Variant
 
 Dim Rws As Long, J As Long, I As Long, lr As Long, Tmr As Double, tR1 As Double, tR2 As Double
 Dim Sht As String, SheetName As String
  Tmr = Timer()
  SheetName = InputBox("Nhap ten sheet can cham cong", "TUE ANH")
  If SheetExists(SheetName) Then
    MsgBox SheetName
  End If
  
 lr = [c65000].End(3).Row
 Range(Cells(lr + 1, 1), Cells(lr + 10000, 45)).Clear
   Rws = [b9].CurrentRegion.Rows.Count - 8
   Arr() = [F9].Resize(Rws, 8).Value
 ReDim dArr(1 To Rws, 1 To 3)
 ReDim a1Arr(1 To Rws, 1 To 1)'Dinh dang
 [A5:AS5].Copy
 [A9].Resize(Rws, 45).PasteSpecial Paste:=xlPasteFormats
 [H9].Resize(Rws, 2).Replace What:="(+1)", Replacement:=""
'Tong Thòi Gian Làm Viec:'
 For J = 1 To UBound(Arr())
    Sht = Arr(J, 1)
    If Arr(J, 6) <> "" And Arr(J, 7) <> "" And Arr(J, 8) <> "" Then
        dArr(J, 1) = Arr(J, 6):            dArr(J, 2) = Arr(J, 7)
       
    ElseIf Arr(J, 3) <= GQC(Sht) And Arr(J, 4) >= GQC(Sht, False) Then
            dArr(J, 1) = GQC(Sht)
            dArr(J, 2) = GQC(Sht, False)
    End If
    dArr(J, 3) = (dArr(J, 2) - dArr(J, 1)) * 24
    
 Next J
 [o9].Resize(Rws, 3).Value = dArr()
 
'Com Giua Ca I:
   Arr() = [R9].Resize(Rws, 2).Value
 ReDim dArr(1 To Rws, 1 To 1)
 For J = 1 To UBound(Arr())
    If Arr(J, 2) <> "" Then
        dArr(J, 1) = Round((Arr(J, 2) - Arr(J, 1)) * 24, 2) + IIf(Round((Arr(J, 2) - Arr(J, 1)) * 24, 2) = 0.5, 0.5, 0)
 
    End If
 Next J
 [t9].Resize(Rws).Value = dArr()
 
 'Com Giua Ca II:'
 Arr() = [U9].Resize(Rws, 2).Value
 ReDim dArr(1 To Rws, 1 To 1)
 For J = 1 To UBound(Arr())
    If Arr(J, 2) <> "" Then
        dArr(J, 1) = Round((Arr(J, 2) - Arr(J, 1)) * 24, 2)
    End If
 Next J
 [W9].Resize(Rws).Value = dArr()
 
 'Ma hoa chuc vu
 
  Arr() = [G9].Resize(Rws).Value
 ReDim dArr(1 To Rws, 1 To 1)
 For J = 1 To UBound(Arr())
    If Arr(J, 1) = "Senior Manager" Then
        dArr(J, 1) = "A"
    ElseIf Arr(J, 1) = "Manager" Then
        dArr(J, 1) = "B"
    ElseIf Arr(J, 1) = "Ast Manager" Then
        dArr(J, 1) = "C"
    Else
        dArr(J, 1) = "D"
        
    End If
 Next J
 [N9].Resize(Rws).Value = dArr()
 
 'Danh so thu tu
 
 Arr() = [C9].Resize(Rws).Value
 ReDim dArr(1 To Rws, 1 To 1)
 For J = 1 To UBound(Arr())
    If Arr(J, 1) <> "" Then
      dArr(J, 1) = J
    End If
 Next J
 
 [A9].Resize(Rws).Value = dArr() 
 'Tong TG Làm Viec Thuc Te... X
 '1
 Arr() = [F9].Resize(Rws, 18).Value
 ReDim dArr(1 To Rws, 1 To 2)
 For J = 1 To UBound(Arr())
    If Arr(J, 1) > w And Arr(J, 12) >= 8.5 Then
        dArr(J, 1) = Arr(J, 12) - 0.5
    Else
        dArr(J, 1) = Round(Arr(J, 12) - Arr(J, 15) - Arr(J, 18), 2)
    End If'Thoi gian huong che do Y
'2
    dArr(J, 2) = IIf(Arr(J, 8) = "S", 1, 0)
  
  Next J
 [X9].Resize(Rws, 2).Value = dArr()
   
'Tong TG Làm Viec Duoc Tinh Z
'1
 Arr() = [F9].Resize(Rws, 21).Value
 ReDim dArr(1 To Rws, 1 To 3)
 For J = 1 To UBound(Arr())
 
    If Arr(J, 1) = "H" Or Arr(J, 1) = "N" Then
      dArr(J, 1) = Arr(J, 12) - Arr(J, 15) - IIf(Arr(J, 11) <= [Q8], Arr(J, 18), 0)
    Else
      dArr(J, 1) = Arr(J, 12)
    End If'Cong Ngay
'2
    If Arr(J, 1) = "H" Or Arr(J, 1) = "N" Then
        dArr(J, 2) = (IIf(Arr(J, 11) >= [AA7], [AA7], Arr(J, 11)) - IIf(Arr(J, 10) <> 0 And Arr(J, 10) - [Q7] <= 0, [Q7], Arr(J, 10))) * 24 - Arr(J, 15)
                                          
    ElseIf Arr(J, 1) = "D" Or Arr(J, 1) = "Z" Then
        dArr(J, 2) = 0
        
    ElseIf Arr(J, 1) = "X" Then
        dArr(J, 2) = (IIf(Arr(J, 11) - [AE7] >= 0, [AE7], Arr(J, 11)) - IIf(Arr(J, 10) <> 0 And Arr(J, 10) - [AD7] <= 0, [AD7], Arr(J, 10))) * 24
                        
    ElseIf Arr(J, 1) = "Y" Then
        dArr(J, 2) = (IIf(Arr(J, 11) - [AC7] >= 0, [AC7], Arr(J, 11)) - IIf(Arr(J, 10) <> 0 And Arr(J, 10) - [AE7] <= 0, [AE7], Arr(J, 10))) * 24
    Else: dArr(J, 2) = 0
    
    End If
         
'Cong dem
'3
If Arr(J, 1) = "D" Or Arr(J, 1) = "Z" Then    If Arr(J, 11) < [AC7] Then
    dArr(J, 3) = 0
    Else
    dArr(J, 3) = (IIf(Arr(J, 11) - [AB7] >= 0, [AB7], Arr(J, 11)) - IIf(Arr(J, 10) <> 0 And Arr(J, 10) <= [AC7], [AC7], Arr(J, 10))) * 24
    End If
Else
    dArr(J, 3) = 0
    
End If
       
  Next J
 [Z9].Resize(Rws, 3).Value = dArr()'OVT ngay
'6Arr() = [F9].Resize(Rws, 23).Value
 ReDim dArr(1 To Rws, 1 To 1)
 For J = 1 To UBound(Arr())
    If Arr(J, 10) >= [AC7] Then
    dArr(J, 1) = 0
    ElseIf Arr(J, 11) <= [AC7] Then
     dArr(J, 1) = Arr(J, 21) - Arr(J, 22) - Arr(J, 23)
    Else: dArr(J, 1) = Arr(J, 21) - Arr(J, 22) - (Arr(J, 11) - [AC7]) * 24
    
End If
     
    dArr(J, 1) = Round(dArr(J, 1), 2)
    
      Next J
[AC9].Resize(Rws, 1).Value = dArr()
          
'OVT D1-D2Arr() = [Y9].Resize(Rws, 5).Value
 ReDim dArr(1 To Rws, 1 To 2)
 For J = 1 To UBound(Arr())
    If Arr(J, 5) > 0 Then
    dArr(J, 1) = Round(Arr(J, 2) - Arr(J, 3) - Arr(J, 4) - Arr(J, 5), 2)
    dArr(J, 2) = 0
    Else
    dArr(J, 1) = 0
    dArr(J, 2) = Round(Arr(J, 2) - Arr(J, 3) - Arr(J, 4) - Arr(J, 5), 2)
    
End If
    
Next J
 [AD9].Resize(Rws, 2).Value = dArr()
 
 'OVT chu nhat
 
Arr() = [AA9].Resize(Rws, 5).Value
 ReDim dArr(1 To Rws, 1 To 4)
 For J = 1 To UBound(Arr())
    dArr(J, 1) = 0
    dArr(J, 2) = 0
    dArr(J, 3) = Arr(J, 1) + Arr(J, 3)
    dArr(J, 4) = Arr(J, 2) + Arr(J, 4) + Arr(J, 5)
 
Next J
 [AA9].Resize(Rws, 4).Value = dArr()'Tong OVT
 Arr() = [AC9].Resize(Rws, 3).Value
 ReDim dArr(1 To Rws, 1 To 1)
 For J = 1 To UBound(Arr())
    dArr(J, 1) = Arr(J, 1) + Arr(J, 2) + Arr(J, 3)
 Next J
 [AF9].Resize(Rws).Value = dArr()
 
 'PC mua cao diem
   Arr() = [F9].Resize(Rws, 14).Value
 ReDim dArr(1 To Rws, 1 To 1)
 For J = 1 To UBound(Arr())
 If Arr(J, 1) = "H" Or Arr(J, 1) = "N" Then
    If Round(Arr(J, 14) - Arr(J, 13), 2) = 0.02 Then
        dArr(J, 1) = "A"
    Else: dArr(J, 1) = 0
    End If
 ElseIf Arr(J, 1) <> "H" Or Arr(J, 1) <> "N" Then
 dArr(J, 1) = 0
 
 End If
  Next J
 [AG9].Resize(Rws).Value = dArr()
 
 'Quy ra cong
 
  Arr() = [F9].Resize(Rws, 28).Value
 ReDim dArr(1 To Rws, 1 To 7)
 For J = 1 To UBound(Arr())
 If Arr(J, 21) = 0 Then
    dArr(J, 1) = "N"
 ElseIf Arr(J, 22) <> 0 Then
 dArr(J, 1) = Round(Arr(J, 22) / 8, 2) & Arr(J, 1)
 Else
 dArr(J, 1) = Round(Arr(J, 23) / 8, 2) & Arr(J, 1)
End If
 If Arr(J, 1) = "LT" Then
    dArr(J, 2) = "LT"
 ElseIf Arr(J, 21) = 0 Then
    dArr(J, 2) = "N"
 ElseIf Arr(J, 1) = "X" Or Arr(J, 1) = "Y" Or Arr(J, 1) = "N" Or Arr(J, 1) = "H" Then
    dArr(J, 2) = Round((Arr(J, 22) / 8), 2)
    
 ElseIf dArr(J, 1) = "1Z" Or dArr(J, 1) = "1D" Then
    dArr(J, 2) = "D"
 Else:
    dArr(J, 2) = dArr(J, 1)
End If
 
 If Arr(J, 9) < "C" Then
 dArr(J, 3) = Arr(J, 24) * 0.3
 dArr(J, 4) = Arr(J, 25) * 0.3
 dArr(J, 5) = Arr(J, 26) * 0.3
 
 ElseIf Arr(J, 9) = "C" Then
 
 dArr(J, 3) = Arr(J, 24) * 0.5
 dArr(J, 4) = Arr(J, 25) * 0.5
 dArr(J, 5) = Arr(J, 26) * 0.5
 
 Else:
 dArr(J, 3) = Arr(J, 24)
 dArr(J, 4) = Arr(J, 25)
 dArr(J, 5) = Arr(J, 26)
 
 End If
 
 dArr(J, 6) = dArr(J, 3) + dArr(J, 4) + dArr(J, 5)
 dArr(J, 7) = Arr(J, 28)
 
   Next J
 [AH9].Resize(Rws, 7).Value = dArr()
  
 [A3].Value = Timer() - Tmr
 
 
 End SubFunction GQC(Shift As String, Optional Vo As Boolean = True) As Double
 Select Case Shift
 Case "D"
    If Vo Then
        GQC = TimeSerial(20, 0, 0)
    Else
        GQC = TimeSerial(32, 0, 0)
    End If
 Case "H"
    If Vo Then
        GQC = TimeSerial(8, 0, 0)
    Else
        GQC = TimeSerial(17, 0, 0)
    End If
 Case "N"
    If Vo Then
        GQC = TimeSerial(8, 0, 0)
    Else
        GQC = TimeSerial(20, 0, 0)
    End If
 Case "X"
    If Vo Then
        GQC = TimeSerial(6, 0, 0)
    Else
        GQC = TimeSerial(14, 0, 0)
    End If
 Case "Y"
    If Vo Then
        GQC = TimeSerial(14, 0, 0)
    Else
        GQC = TimeSerial(22, 0, 0)
    End If
 
 Case "Z"
    If Vo Then
        GQC = TimeSerial(22, 0, 0)
    Else
        GQC = TimeSerial(30, 0, 0)
    End If
 
 End Select
End Function Function SheetExists(ByVal SheetName As String) As Boolean
  On Error Resume Next
  SheetExists = Not Sheets(SheetName) Is Nothing
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Sau khi xác định đươc SheetName, bạn chưa cho biết bạn "làm việc" với sheet nào.
Thử như vầy xem:
PHP: 
SheetName = InputBox("Nhap ten sheet can cham cong", "TUE ANH")
  If SheetExists(SheetName) Then
    MsgBox SheetName
  End If

With Sheets(SheetName)        '---------Thêm dòng này, sau đó tất cả các "Range" bạn thêm dấu "chấm" phía trước như bên dưới'
 lr = .[c65000].End(3).Row
 .Range(.Cells(lr + 1, 1), .Cells(lr + 10000, 45)).Clear
   Rws = .[b9].CurrentRegion.Rows.Count - 8
   Arr() = .[F9].Resize(Rws, 8).Value
 ReDim dArr(1 To Rws, 1 To 3)
 ReDim a1Arr(1 To Rws, 1 To 1)'Dinh dang'
 .[A5:AS5].Copy
 .[A9].Resize(Rws, 45).PasteSpecial Paste:=xlPasteFormats

'-------------------------------------------------------Thêm dấu chấm đến cuối Sub'
End With
End Sub
 [
@@@ Code của bạn chạy đúng hay sai tôi không biết à nghe.
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn anh Ba Tê nhé, em làm được rồi anh ạ!
 
Upvote 0
Cho em hỏi giả sử em gán giá trị từ A1 đến A10 sang B1 đến B10 bằng cách dung mảng trong VBA. Tuy nhiên dòng 4 đang bị ẩn do em đang lọc Filter ở cột A và B thì có gán được không ạ. Nếu được thì em phải làm thế nào. Vẫn giữ nguyên ẩn không hiện anh chị em nhé.
 
Lần chỉnh sửa cuối:
Upvote 0
Các bác cho em hỏi WPS spreadsheet có xài được VBA không ạ, và nếu có thì mở cửa sổ như thế nào ạ
 
Upvote 0
If Arr(J, 1) = "Senior Manager" Then
dArr(J, 1) = "A"
ElseIf Arr(J, 1) = "Manager" Then
dArr(J, 1) = "B"
ElseIf Arr(J, 1) = "Ast Manager" Then
dArr(J, 1) = "C"
Else
dArr(J, 1) = "D"

Câu lệnh trên có thể giảm bớt if đi được không ạ?
 
Upvote 0
@befaint:
Với nhiều if-else if thì cách code đúng đắn nhất là dùng select case (xem giải thích ở dưới).
Nếu cố tình ép giảm số dòng code thì trong trường hợp này dùng hàm Instr tìm trong chuỗi để lấy vị trí đẹp mắt hơn.
Mã: 
= Choose((instr("|Senior Manager|Manager       |Ast Manager   |", "|"&Arr(J,1)&"|")+14)/15+1, "D", "A", "B", "C")

Giải thích: hàm iif là hàm không được hữu hiệu lắm của VBA cho nên khi dùng lồng nhau lại càng mất hiệu quả. VBA phải tính tất cả các biểu thức tham số của hàm. Khác với if-else và select-case, VBA chỉ tính đến lúc gặp đúng chỗ true thì thôi.
 
Lần chỉnh sửa cuối:
Upvote 0
VetMini đã viết:
@befaint:
Với nhiều if-else if thì cách code đúng đắn nhất là dùng select case (xem giải thích ở dưới).
Nếu cố tình ép giảm số dòng code thì trong trường hợp này dùng hàm Instr tìm trong chuỗi để lấy vị trí đẹp mắt hơn.
Mã: 
= Choose((instr("|Senior Manager|Manager       |Ast Manager   |", "|"&Arr(J,1)&"|")+14)/15+1, "D", "A", "B", "C")

Giải thích: hàm iif là hàm không được hữu hiệu lắm của VBA cho nên khi dùng lồng nhau lại càng mất hiệu quả. VBA phải tính tất cả các biểu thức tham số của hàm. Khác với if-else và select-case, VBA chỉ tính đến lúc gặp đúng chỗ true thì thôi.
Nhấp chuột vào đây để mở rộng...

Với Sennior thì chạy đúng nhưng tại sao Manager và Ast Manager lại đều cho đáp án là B vậy nhỉ? Không biết mình có làm sai ở đâu không.
 
Upvote 0
Ủa ghi lộn chuỗi cái, như vầy mới đúng:
Mã: 
"|12345678901234|12345678901234|12345678901234|"
"|Senior Manager|Manager|++++++|Ast Manager|++|"
(độn như thế nào để khoảng cách giữa điểm khởi đầu các chức vụ là 15 ký tự
 
Upvote 0
VetMini đã viết:
Ủa ghi lộn chuỗi cái, như vầy mới đúng:
Mã: 
 "|12345678901234|12345678901234|12345678901234|"
 "|Senior Manager|Manager|++++++|Ast Manager|++|"
(độn như thế nào để khoảng cách giữa điểm khởi đầu các chức vụ là 15 ký tự
Nhấp chuột vào đây để mở rộng...

Hay quá được rồi, cái này giống như index trong excel nhỉ. Cảm ơn VetMini
  • PHP: 
    dArr(J, 1) = Choose((InStr("|Senior Manager|Manager|++++++|Ast Manager|++|", "|" & Arr(J, 1) & "|") + 14) / 15 + 1, "D", "A", "B", "C")
Mà cái này sao lại 14 và 15+1? Các giá trị ngoài Sennior, Manager, Ast Manager lấy thành D qua từ nào ở code trên vậy nhỉ?
 
Lần chỉnh sửa cuối:
Upvote 0
tueyennhi đã viết:
Mà cái này sao lại 14 và 15+1? Các giá trị ngoài Sennior, Manager, Ast Manager lấy thành D qua từ nào ở code trên vậy nhỉ?
Nhấp chuột vào đây để mở rộng...

1+14 = 15 --> 15/15 = 1 --> 1+1 = 2 --> choose trị thứ 2 trong "D","A","B","C" thì là "A"
16+14 = 30 --> 30/15 = 2 --> 2+1 = 3 --> choose trị thứ 3 trong "D","A","B","C" thì là "B"
Nếu không tìm được thì hàm Instr trả về 0
0+14 = 14 --> 14/15 = 0,nnnnn --> 0,nnnnn+1 = 1,nnnnn --> bỏ số lẻ còn lại 1 --> choose trị 1 trong "D","A","B","C" thì là "D"
 
Upvote 0
VetMini đã viết:
1+14 = 15 --> 15/15 = 1 --> 1+1 = 2 --> choose trị thứ 2 trong "D","A","B","C" thì là "A"
16+14 = 30 --> 30/15 = 2 --> 2+1 = 3 --> choose trị thứ 3 trong "D","A","B","C" thì là "B"
Nếu không tìm được thì hàm Instr trả về 0
0+14 = 14 --> 14/15 = 0,nnnnn --> 0,nnnnn+1 = 1,nnnnn --> bỏ số lẻ còn lại 1 --> choose trị 1 trong "D","A","B","C" thì là "D"
Nhấp chuột vào đây để mở rộng...

:). Cảm ơn rất nhiều! VetMini
 
Upvote 0
Bạn tham khảo cách tăng lên các dòng lệnh, chớ giảm làm gì?

tueyennhi đã viết:
If Arr(J, 1) = "Senior Manager" Then
dArr(J, 1) = "A"
ElseIf Arr(J, 1) = "Manager" Then
dArr(J, 1) = "B"
ElseIf Arr(J, 1) = "Ast Manager" Then
dArr(J, 1) = "C"
Else
dArr(J, 1) = "D"

Câu lệnh trên có thể giảm bớt if đi được không ạ?
Nhấp chuột vào đây để mở rộng...
PHP: 
Option Explicit
Sub gpeSWITCH()
 Dim J As Long, Arr(), Tmp As Variant
 On Error GoTo LoiCT
 
 Arr() = Range([B2], [B2].End(xlDown))
 ReDim dArr(1 To UBound(Arr()), 1 To 1)
 For J = 1 To UBound(Arr())
    Tmp = Arr(J, 1)
    dArr(J, 1) = Switch(Tmp = "Senior Manager", "A", Tmp = "Manager", "B", Tmp = "Ast Manager", "C")
    If InStr("ABC", dArr(J, 1)) Then
    Else
        MsgBox dArr(J, 1)
    End If
GPE:    Next J
 [D2].Resize(J - 1).Value = dArr()
Err_:                               Exit Sub
LoiCT:
    If Err = 94 Then
        dArr(J, 1) = "D":           Err = 0
        Resume GPE
    Else
        MsgBox Err, , Error:        Resume Err_
    End If
End Sub
 
Upvote 0
Lỗi không gọi được sự kiện SheetSelectionChange

mọi người giúp em lỗi này với nhé. ngồi cả ngày search google rồi, không biết cách khắc phục
nội dung lỗi em có nêu trong file đính kèm
 
Upvote 0
ChanhTQ@ đã viết:
PHP: 
Option Explicit
Sub gpeSWITCH()
 Dim J As Long, Arr(), Tmp As Variant
 On Error GoTo LoiCT
 
 Arr() = Range([B2], [B2].End(xlDown))
 ReDim dArr(1 To UBound(Arr()), 1 To 1)
 For J = 1 To UBound(Arr())
    Tmp = Arr(J, 1)
    dArr(J, 1) = Switch(Tmp = "Senior Manager", "A", Tmp = "Manager", "B", Tmp = "Ast Manager", "C")
    If InStr("ABC", dArr(J, 1)) Then
    Else
        MsgBox dArr(J, 1)
    End If
GPE:    Next J
 [D2].Resize(J - 1).Value = dArr()
Err_:                               Exit Sub
LoiCT:
    If Err = 94 Then
        dArr(J, 1) = "D":           Err = 0
        Resume GPE
    Else
        MsgBox Err, , Error:        Resume Err_
    End If
End Sub
Nhấp chuột vào đây để mở rộng...

Em tưởng rằng thì là if càng nhiều thì code chạy càng chậm :). Nhờ code trên của anh mà em cải tiến code của em như sau:
PHP: 
  Arr() = [G9].Resize(Rws).Value

 ReDim dArr(1 To Rws, 1 To 1)

 For J = 1 To UBound(Arr())

 Sht = Arr(J, 1)

 dArr(J, 1) = Switch(Sht = "Senior Manager", "A", Sht = "Manager", "B", Sht = "Ast Manager", "C")

 Next J

 [N9].Resize(Rws).Value = dArr()

Vì giá trị D em không cần. Như thế này không có vấn đề gì anh nhỉ :).
 
Upvote 0
tueyennhi đã viết:
Em tưởng rằng thì là if càng nhiều thì code chạy càng chậm
Nhấp chuột vào đây để mở rộng...

Khi xét nhiều trường hợp thì select case là hiệu quả nhất (trung bình thì nhanh nhất), kế đó là if-else-if
Các phương pháp khác chỉ để cho đẹp mắt, và chỉ hữu hiệu khi số trường hợp cần xét khong lớn lắm (điển hình <= 6)

tueyennhi đã viết:
Vì giá trị D em không cần. Như thế này không có vấn đề gì anh nhỉ :).
Nhấp chuột vào đây để mở rộng...

Nếu bảo đảm không xảy ra trường hợp "D" thì dùng hàm Match và Char(64+n), hoặc Mid("ABC",n,1) là gọn nhất
 
Upvote 0
VetMini đã viết:
Khi xét nhiều trường hợp thì select case là hiệu quả nhất (trung bình thì nhanh nhất), kế đó là if-else-if
Các phương pháp khác chỉ để cho đẹp mắt, và chỉ hữu hiệu khi số trường hợp cần xét khong lớn lắm (điển hình <= 6)
Nếu bảo đảm không xảy ra trường hợp "D" thì dùng hàm Match và Char(64+n), hoặc Mid("ABC",n,1) là gọn nhất
Nhấp chuột vào đây để mở rộng...
Như thế nầy được không?
Mã: 
Darr(j, 1) = Mid(Arr(j, 1) & "ACCCBBBB", 15, 1)
 
Upvote 0
HieuCD đã viết:
Như thế nầy được không?
Mã: 
Darr(j, 1) = Mid(Arr(j, 1) & "ACCCBBBB", 15, 1)
Nhấp chuột vào đây để mở rộng...

Theo mình hiểu thì code trên dựa theo việc đếm ký tự của Arr(j,1) như vậy vẫn có những chức vụ khác nhau mà có số ký tự như sau (Ví dụ Ast Manager với Tech Worker). Code rất hay nhưng không dùng được trong trường hợp này rồi đúng không bạn ?
 
Upvote 0
tueyennhi đã viết:
Theo mình hiểu thì code trên dựa theo việc đếm ký tự của Arr(j,1) như vậy vẫn có những chức vụ khác nhau mà có số ký tự như sau (Ví dụ Ast Manager với Tech Worker). Code rất hay nhưng không dùng được trong trường hợp này rồi đúng không bạn ?
Nhấp chuột vào đây để mở rộng...
các biến tấu đặc biệt cần phải phân tích kỹ lưỡng về qui luật dữ liệu, ở đây là dựa vào sự khác nhau của số ký tự, nếu các giá trị có số ký tự khác nhau thì dùng đươc, nếu có 2 trường hợp số ký tự bằng nhau thì phải dùng cách khác, như tìm 1 ký tự nào đó và dùng hàm Replace chẳng hạn, để chuyển thành số ký tự khác nhau, từ đó mới dùng hàm Mid
 
Lần chỉnh sửa cuối:
Upvote 0
Từ "Senior Manager", "Manager",... chuyển về thành "A", "B", "C",... theo ngôn ngữ CSDL là công việc chuẩn hoá (normalise/ize). Theo ngôn ngữ hành chánh gọi là công việc xếp loại (categorise/ize)
Việc chuẩn hoá luôn luôn rắc rối. Sau khi chuẩn rồi, lúc đó mới dễ làm việc.
 
Upvote 0
tueyennhi đã viết:
Theo mình hiểu thì code trên dựa theo việc đếm ký tự của Arr(j,1) như vậy vẫn có những chức vụ khác nhau mà có số ký tự như sau (Ví dụ Ast Manager với Tech Worker). Code rất hay nhưng không dùng được trong trường hợp này rồi đúng không bạn ?
Nhấp chuột vào đây để mở rộng...

Lệnh ngắn chưa chắc đã hiệu quả cả cho máy tính dịch, lẫn người viết code đọc lại. Trường hợp này tốt nhất bạn thử dùng Select Case sẽ dễ hiểu và hiệu quả.
 
Upvote 0
winvista đã viết:
Lệnh ngắn chưa chắc đã hiệu quả cả cho máy tính dịch, lẫn người viết code đọc lại. Trường hợp này tốt nhất bạn thử dùng Select Case sẽ dễ hiểu và hiệu quả.
Nhấp chuột vào đây để mở rộng...
lệnh ngắn hay dài, chạy nhanh hay chậm là tùy theo đặc điểm của dữ liệu và khả năng phân tích dữ liệu, để dể hiểu thì cứ theo các cách thông thường, cứ lối mòm mà đi là an toàn nhất
trường hợp nầy chỉ có 3 khả năng mà dùng select case có vẻ khó hiểu rờm rà hơn Switch nhiều, còn hiệu quả là một khái niệm gắn liền với mục tiêu qui định trước, những mục tiêu khác nhau sẽ đánh giá hiệu quả khác nhau, không thể nói hiệu quả một cách chung chung được
 
Upvote 0
winvista đã viết:
Lệnh ngắn chưa chắc đã hiệu quả cả cho máy tính dịch, lẫn người viết code đọc lại. Trường hợp này tốt nhất bạn thử dùng Select Case sẽ dễ hiểu và hiệu quả.
Nhấp chuột vào đây để mở rộng...

Vì mình chỉ quan tâm A, B, C nên mình chọn code này của anh ChanhTQ@

PHP: 
  Arr() = [G9].Resize(Rws).Value
 ReDim dArr(1 To Rws, 1 To 1)
 For J = 1 To UBound(Arr())
 Sht = Arr(J, 1)
 
 dArr(J, 1) = Switch(Sht = "Senior Manager", "A", Sht = "Manager", "B", Sht = "Ast Manager", "C")
 Next J
 [N9].Resize(Rws).Value = dArr()

Cho mình hỏi thêm trong vba hình như không có biến giờ. Và muốn bao quát hết phải dùng biến Variant phải không mọi người?
 
Upvote 0
tueyennhi đã viết:
Vì mình chỉ quan tâm A, B, C nên mình chọn code này của anh ChanhTQ@

PHP: 
  Arr() = [G9].Resize(Rws).Value
 ReDim dArr(1 To Rws, 1 To 1)
 For J = 1 To UBound(Arr())
 Sht = Arr(J, 1)
 
 dArr(J, 1) = Switch(Sht = "Senior Manager", "A", Sht = "Manager", "B", Sht = "Ast Manager", "C")
 Next J
 [N9].Resize(Rws).Value = dArr()

Cho mình hỏi thêm trong vba hình như không có biến giờ. Và muốn bao quát hết phải dùng biến Variant phải không mọi người?
Nhấp chuột vào đây để mở rộng...
để hiểu hơn về code, bạn nên tìm đọc Help của VBA
trong phần Help của VBA bạn gỏ từ khóa: Dim
chọn lệnh phù hợp và xem hướng dẫn
 
Upvote 0
Switch là hàm chuyển đổi dữ liệu trực tiếp từ một tập hợp xác định sang tập hợp xác định khác (*1)
Nếu trường hợp này chỉ đơn giản dịch "Senior Manager" sang "A", vv... (tức là dịch trực tiếp trị hằng sang trị hằng) thì nó đúng là gọn nhất.

Các cách IF-ELSE-IF, SELECT-CASE, IIF, INSTR,... mục đích chính là để quyết toán những dữ liệu chả khớp vào đâu cả, trường hợp "D"

Trong tất cả các cách, thông thường IF-ELSE-IF là nhanh và an toàn nhất, bởi vì nó là cách tính từ trên xuống, khi đã đạt 1 true rồi thì bỏ qua các chỗ còn lại (*2).

(*1) lưu ý từ "xác định". Nó có nghĩa là ta đã xác định rằng nó "chỉ như thế", không lệch đi đâu cả.

(*2) chỉ đúng với VBA. Ngược lại, ngôn ngữ khác như C chẳng hạn thì Case là lệnh nhanh nhất (C bắt buộc trường hợp Case phải là hằng)

Chú thích về "an toàn":
IF-ELSE-IF được xem như an toàn hơn IIF, SWITCH, và CHOOSE vì lý do sau đây:
ví dụ bẫy lỗi chia cho 0
Code 1:
if (b <> 0) then
x = a/b
else
x = 0
End if
Code 2:
x = Iif( b <> 0, a/b, 0) ' câu lệnh này không bẫy lỗi được, dù b có 0 hay không, VBA vẫn tính biểu thức a/b như thường
Code 3:
x = Switch(b=0, 0, b<>0, a/b) ' cũng không bẫy lỗi được

Nguyên tắc cần ghi nhớ: các hàm tương dương với IF chỉ dùng để viết cho gọn chứ không có nghĩa là hoàn toàn tương đương. Khi tính đoạn code If, VBA chỉ cần xét đến chõ gặp true, và bỏ qua chỗ còn lại. Khi bước vào hàm, VBA phải tính tất cả các biểu thức tham số, không chừa biểu thức nào.
 
Upvote 0
VetMini đã viết:
Switch là hàm chuyển đổi dữ liệu trực tiếp từ một tập hợp xác định sang tập hợp xác định khác (*1)
Nếu trường hợp này chỉ đơn giản dịch "Senior Manager" sang "A", vv... (tức là dịch trực tiếp trị hằng sang trị hằng) thì nó đúng là gọn nhất.

Các cách IF-ELSE-IF, SELECT-CASE, IIF, INSTR,... mục đích chính là để quyết toán những dữ liệu chả khớp vào đâu cả, trường hợp "D"

Trong tất cả các cách, thông thường IF-ELSE-IF là nhanh và an toàn nhất, bởi vì nó là cách tính từ trên xuống, khi đã đạt 1 true rồi thì bỏ qua các chỗ còn lại (*2).

(*1) lưu ý từ "xác định". Nó có nghĩa là ta đã xác định rằng nó "chỉ như thế", không lệch đi đâu cả.

(*2) chỉ đúng với VBA. Ngược lại, ngôn ngữ khác như C chẳng hạn thì Case là lệnh nhanh nhất (C bắt buộc trường hợp Case phải là hằng)

Chú thích về "an toàn":
IF-ELSE-IF được xem như an toàn hơn IIF, SWITCH, và CHOOSE vì lý do sau đây:
ví dụ bẫy lỗi chia cho 0
Code 1:
if (b <> 0) then
x = a/b
else
x = 0
End if
Code 2:
x = Iif( b <> 0, a/b, 0) ' câu lệnh này không bẫy lỗi được, dù b có 0 hay không, VBA vẫn tính biểu thức a/b như thường
Code 3:
x = Switch(b=0, 0, b<>0, a/b) ' cũng không bẫy lỗi được

Nguyên tắc cần ghi nhớ: các hàm tương dương với IF chỉ dùng để viết cho gọn chứ không có nghĩa là hoàn toàn tương đương. Khi tính đoạn code If, VBA chỉ cần xét đến chõ gặp true, và bỏ qua chỗ còn lại. Khi bước vào hàm, VBA phải tính tất cả các biểu thức tham số, không chừa biểu thức nào.
Nhấp chuột vào đây để mở rộng...
Cám ơn bạn, các kiến thức căn bản nầy rất bổ ích cho mình và rất nhiều người, trước đây mình chỉ mang máng và làm theo cảm giác, bây giờ mới hiểu tường tận vấn đề
chúc bạn năm mới dồi dào sức khỏe, vạn sự như ý /-*+//-*+//-*+/
 
Upvote 0
Nhờ các bạn xử lý dùm trong trường hợp này Mình sử dụng Hàm Find nó sai cái gì mà lỗi code ....yêu cầu mong muốn Mình ghi kèm trong File
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
    If Not Intersect(Target, [D6:D82]) Is Nothing Then
        'If Target.Offset(, -2) > Sheet2.[B6:B20].Find(Target).Offset(, 2) Then
        If Target.Value > Sheet2.[B:B].Find(Target).Offset(, 2) Then
            MsgBox "ok"
        End If
    End If
Application.EnableEvents = True
End Sub

Xin cảm ơn
 

File đính kèm

Upvote 0
kieu manh đã viết:
Nhờ các bạn xử lý dùm trong trường hợp này Mình sử dụng Hàm Find nó sai cái gì mà lỗi code ....yêu cầu mong muốn Mình ghi kèm trong File
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
    If Not Intersect(Target, [D6:D82]) Is Nothing Then
        'If Target.Offset(, -2) > Sheet2.[B6:B20].Find(Target).Offset(, 2) Then
        If Target.Value > Sheet2.[B:B].Find(Target).Offset(, 2) Then
            MsgBox "ok"
        End If
    End If
Application.EnableEvents = True
End Sub

Xin cảm ơn
Nhấp chuột vào đây để mở rộng...
vụ nầy hơi nghi ngờ, làm đại sai đúng hên xui
Mã: 
If Target.Value > Sheet2.[B:B].Find(Target.Offset(, -2)).Offset(, 2) Then
 
Upvote 0

File đính kèm

Upvote 0
kieu manh đã viết:
Nhờ các bạn xử lý dùm trong trường hợp này Mình sử dụng Hàm Find nó sai cái gì mà lỗi code ....yêu cầu mong muốn Mình ghi kèm trong File
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
    If Not Intersect(Target, [D6:D82]) Is Nothing Then
        'If Target.Offset(, -2) > Sheet2.[B6:B20].Find(Target).Offset(, 2) Then
        If Target.Value > Sheet2.[B:B].Find(Target).Offset(, 2) Then
            MsgBox "ok"
        End If
    End If
Application.EnableEvents = True
End Sub

Xin cảm ơn
Nhấp chuột vào đây để mở rộng...
Thử vầy xem kieu manh
Mã: 
If Target > Sheet2.Range("B:B").Find(Target.Offset(0, -2)).Offset(0, 2) Then
 
Upvote 0
kieu manh đã viết:
Có ma hay sao ý nó chỉ sai cels D10,20,21 còn các Cels khác đúng....Coi Lai Format như nhau mà ...
Nhấp chuột vào đây để mở rộng...

Có ma là do bạn sai 2 chỗ:
1> Thứ nhất: bạn dùng cặp lệnh Application.EnableEvents = False/True ở đầu và cuối code nên trường hợp có lỗi nào đó xuất hiện thì EnableEvents sẽ không trả về True, dẫn đến lệnh Change mất tác dụng, gõ gì cũng.. sai
Giải pháp: Bạn không có code nào tác động trực tiếp lên Target cell nên không cần cặp lệnh trên
2> Find method viết thế là thiếu và sai nghiêm trọng, sẽ có lúc đúng lúc sai
-------------------------
Tóm lại sửa code thế này sẽ ổn:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rFind As Range
  If Not Intersect(Target, [D6:D82]) Is Nothing Then
    Set rFind = Sheet2.Range("B:B").Find(Target.Offset(, -2).Value, , xlValues, xlWhole)  ''<-- Find method viết cho đầy đù, không được viết tắt
    If Not rFind Is Nothing Then
      If Target.Value > rFind.Offset(, 2) Then
        MsgBox "ok"
        Target.Select
      End If
    End If
  End If
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Có ma là do bạn sai 2 chỗ:
1> Thứ nhất: bạn dùng cặp lệnh Application.EnableEvents = False/True ở đầu và cuối code nên trường hợp có lỗi nào đó xuất hiện thì EnableEvents sẽ không trả về True, dẫn đến lệnh Change mất tác dụng, gõ gì cũng.. sai
Giải pháp: Bạn không có code nào tác động trực tiếp lên Target cell nên không cần cặp lệnh trên
2> Find method viết thế là thiếu và sai nghiêm trọng, sẽ có lúc đúng lúc sai
-------------------------
Tóm lại sửa code thế này sẽ ổn:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rFind As Range
  If Not Intersect(Target, [D6:D82]) Is Nothing Then
    Set rFind = Sheet2.Range("B:B").Find(Target.Offset(, -2).Value[COLOR=#ff0000], , xlValues, xlWhole[/COLOR])  ''<-- Find method viết cho đầy đù, không được viết tắt
    If Not rFind Is Nothing Then
      If Target.Value > rFind.Offset(, 2) Then
        MsgBox "ok"
        Target.Select
      End If
    End If
  End If
End Sub
Nhấp chuột vào đây để mở rộng...

Em cứ nghĩ chỗ màu đỏ bỏ bớt đi cũng ok ...cho nó gọn
Cảm ơn Anh
 
Upvote 0
kieu manh đã viết:
Em cứ nghĩ chỗ màu đỏ bỏ bớt đi cũng ok ...cho nó gọn
Cảm ơn Anh
Nhấp chuột vào đây để mở rộng...

Bỏ bớt là SAI NGHIÊM TRỌNG luôn
- xlValues tương đương với bấm Ctrl + F chọn Values trong hộp Look in
- xlWhole tương đương với bấm Ctrl + F và check mục "Match entire cells contents"
Nếu bạn rút gọn thì code sẽ lấy theo lần bạn Find cuối cùng trên bảng tính
---------------------
Tóm lại; cái gì rút gọn được, riêng find method thì không
Ngoài ra nếu không có đoạn If not rFind is nothing thì e rằng không ổn. Ai dám chắc ăn 100% việc tìm kiếm luôn ra kết quả. Nếu tìm không thấy thì sao?
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Bỏ bớt là SAI NGHIÊM TRỌNG luôn
- xlValues tương đương với bấm Ctrl + F chọn Values trong hộp Look in
- xlWhole tương đương với bấm Ctrl + F và check mục "Match entire cells contents"
Nếu bạn rút gọn thì code sẽ lấy theo lần bạn Find cuối cùng trên bảng tính
---------------------
Tóm lại; cái gì rút gọn được, riêng find method thì không
Ngoài ra nếu không có đoạn If not rFind is nothing thì e rằng không ổn. Ai dám chắc ăn 100% việc tìm kiếm luôn ra kết quả. Nếu tìm không thấy thì sao?
Nhấp chuột vào đây để mở rộng...

Anh ... có người Bạn mới viết cho Em vầy Anh thấy cách này có hay .... hay cách xài Find hay hơn
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target > Application.WorksheetFunction.VLookup(Target.Offset(, -2), Sheet2.[B6:D20], 3, 0) Then
        MsgBox "ok"
        Target.Select
    End If
End Sub
 
Upvote 0
Vlookup rất nhanh nếu dữ liệu đã sắp xếp.
Khi tham số cuối là 1 thì các hàm như Vlookup , Match,... dùng phép tìm nhị phân, hội tụ rất nhanh khi dữ liệu lớn.
 
Upvote 0
langtuchungtinh360 đã viết:
hú bà...........hú bà.................ai giúp em với....................:.,:.,
Nhấp chuột vào đây để mở rộng...

cODE của bạn tè le khủng khủng thế ai giúp được, nhất là không mô tả chi tiết là lỗi ở đâu, cấu trúc code thế nào, không có ghi chú trong code, thì không ai hiểu mà sửa đâu trừ tác giả viết ra nó
(xin lỗi bạn, lời nói thật như thuốc đắng, nếu sai bỏ qua)
 
Lần chỉnh sửa cuối:
Upvote 0
winvista đã viết:
nhất là không mô tả chi tiết là lỗi ở đâu
Nhấp chuột vào đây để mở rộng...
- trong file có mô tả bước làm xảy ra lỗi nhé bạn.
- file ban đầu mình up thì sẽ xuất hiện lỗi vì chưa có textbox
- file hiện tại thì ở B1 và B2 thì ko thấy lỗi được.
- phải xóa đi cái textbox đi rồi thực hiện lại mới có
- mình có nêu chỗ sẽ xảy ra lỗi tại dòng 15 trong file đính kèm nhé
winvista đã viết:
không có ghi chú trong code
Nhấp chuột vào đây để mở rộng...
- trong file code có ghi chú mà ít thôi chứ không phải không có nhé
ps: mình cũng chả muốn up file 1 đóng code như thế lên đâu. người giúp sẽ ngán khi xem, nhưng nếu up file không đầy đủ code để phục vụ nó thì không thấy được chỗ lỗi thì hỏi làm chi nữa bạn.
 
Upvote 0
langtuchungtinh360 đã viết:
- trong file có mô tả bước làm xảy ra lỗi nhé bạn.
- file ban đầu mình up thì sẽ xuất hiện lỗi vì chưa có textbox
- file hiện tại thì ở B1 và B2 thì ko thấy lỗi được.
- phải xóa đi cái textbox đi rồi thực hiện lại mới có
- mình có nêu chỗ sẽ xảy ra lỗi tại dòng 15 trong file đính kèm nhé

- trong file code có ghi chú mà ít thôi chứ không phải không có nhé
ps: mình cũng chả muốn up file 1 đóng code như thế lên đâu. người giúp sẽ ngán khi xem, nhưng nếu up file không đầy đủ code để phục vụ nó thì không thấy được chỗ lỗi thì hỏi làm chi nữa bạn.
Nhấp chuột vào đây để mở rộng...

Thế thì chờ cao nhân giúp vậy, tôi thì không ghi chú đầy đủ thì khó đọc hiểu (nếu không muốn nói là không thể) khi code trên 50 dòng trở lên là bắt đầu rối
 
Upvote 0
kieu manh đã viết:
Anh ... có người Bạn mới viết cho Em vầy Anh thấy cách này có hay .... hay cách xài Find hay hơn
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target > Application.WorksheetFunction.VLookup(Target.Offset(, -2), Sheet2.[B6:D20], 3, 0) Then
        MsgBox "ok"
        Target.Select
    End If
End Sub
Nhấp chuột vào đây để mở rộng...

Hay dở tôi không dám nói, mà nhanh hay chậm cũng không test được luôn... vì đằng nào cũng tìm có 1 giá trị, vèo cái là xong
Tuy nhiên khi tôi viết code thì rất hạn chế dùng WorksheetFunction, trừ trường hợp bất khả kháng...
(mà dù cho dùng VLOOKUP thì sao bạn vẫn bỏ qua vụ bẫy lỗi nhỉ?)
 
Upvote 0
ndu96081631 đã viết:
Hay dở tôi không dám nói, mà nhanh hay chậm cũng không test được luôn... vì đằng nào cũng tìm có 1 giá trị, vèo cái là xong
Tuy nhiên khi tôi viết code thì rất hạn chế dùng WorksheetFunction, trừ trường hợp bất khả kháng...
(mà dù cho dùng VLOOKUP thì sao bạn vẫn bỏ qua vụ bẫy lỗi nhỉ?)
Nhấp chuột vào đây để mở rộng...

Hàm em đâu có biết gì đâu mà bẩy lỗi ...Họ viết cho sao biết vậy thôi chứ ...Anh thấy trên GPE có bao giờ Em viết Hàm đâu mà..!$@!!
 
Upvote 0
kieu manh đã viết:
Hàm em đâu có biết gì đâu mà bẩy lỗi ...Họ viết cho sao biết vậy thôi chứ ...Anh thấy trên GPE có bao giờ Em viết Hàm đâu mà..!$@!!
Nhấp chuột vào đây để mở rộng...

Thì Find hay VLOOKUP cũng vậy, lỗi sẽ xuất hiện khi không tìm thấy, như nhau cả mà... nên cuối cùng vẫn không nên bỏ qua công đoạn bẫy lỗi
Muốn biết phải bẫy ra sao, bạn có test các trường hợp
 
Upvote 0
ndu96081631 đã viết:
Thì Find hay VLOOKUP cũng vậy, lỗi sẽ xuất hiện khi không tìm thấy, như nhau cả mà... nên cuối cùng vẫn không nên bỏ qua công đoạn bẫy lỗi
Muốn biết phải bẫy ra sao, bạn có test các trường hợp
Nhấp chuột vào đây để mở rộng...


oK Anh ...Em mới thử Empty hết là code nhảy vàng lên hết
 
Upvote 0
langtuchungtinh360 đã viết:
mọi người giúp em lỗi này với nhé. ngồi cả ngày search google rồi, không biết cách khắc phục
nội dung lỗi em có nêu trong file đính kèm
Nhấp chuột vào đây để mở rộng...
mình đã tìm ra lỗi (không biết phải không) nhưng hiện tại chưa có cách khắc phục
cụ thể là class làm việc với đối tượng textbox
khi gọi Class thì nội dung class đó có code làm việc với textbox nhưng trong sheet không có textbox vì thế nó bị lỗi 438 và code không làm việc được
vậy làm sao để kiểm tra textbox có tồn tại không
nếu không thì chèn textbox và thực hiện code tiếp tục (code vẫn tiếp tục làm việc - sự kiện vẫn còn chứ không phải dừng lại mất luôn sự kiện)
vì code kiểm tra và chèn đối tượng trong khi chạy code thì hình như nó không được cập nhật hay sao ấy. Việc set đối tượng mới vừa chèn không thành công. Chỉ khi có đối tượng rồi thì chạy code mới set được.
ps: diễn đạt có thể hơi khó hiểu. Chắc tự xử luôn quá
 
Upvote 0
langtuchungtinh360 đã viết:
mình đã tìm ra lỗi (không biết phải không) nhưng hiện tại chưa có cách khắc phục
cụ thể là class làm việc với đối tượng textbox
khi gọi Class thì nội dung class đó có code làm việc với textbox nhưng trong sheet không có textbox vì thế nó bị lỗi 438 và code không làm việc được
vậy làm sao để kiểm tra textbox có tồn tại không
nếu không thì chèn textbox và thực hiện code tiếp tục (code vẫn tiếp tục làm việc - sự kiện vẫn còn chứ không phải dừng lại mất luôn sự kiện)
vì code kiểm tra và chèn đối tượng trong khi chạy code thì hình như nó không được cập nhật hay sao ấy. Việc set đối tượng mới vừa chèn không thành công. Chỉ khi có đối tượng rồi thì chạy code mới set được.
ps: diễn đạt có thể hơi khó hiểu. Chắc tự xử luôn quá
Nhấp chuột vào đây để mở rộng...

Kiểu này giống chưa đẻ trứng đã lo nuôi gà chọi đây

nên kiểm tra tồn tại textbox trước khi tạo object, đoạn code sau là ví dụ ktra tồn tại của textbox chưa
Mã: 
[LEFT][COLOR=#222222][FONT=&amp]Dim TextBox As Shape[/FONT][/COLOR]
[COLOR=#222222][FONT=&amp]On Error Resume Next[/FONT][/COLOR]
[COLOR=#222222][FONT=&amp]Set TextBox = ThisWorkbook.Sheets("Sheet[/FONT][/COLOR][COLOR=#222222][FONT=&amp]1").Shapes[/FONT][/COLOR][COLOR=#222222][FONT=&amp]("txtFullN[/FONT][/COLOR][COLOR=#222222][FONT=&amp]ame")[/FONT][/COLOR]
[COLOR=#222222][FONT=&amp]On Error GoTo 0[/FONT][/COLOR]
[COLOR=#222222][FONT=&amp]If Not TextBox Is Nothing Then MsgBox "txtFullName exists."[/FONT][/COLOR][/LEFT]
 
Upvote 0
winvista đã viết:
Kiểu này giống chưa đẻ trứng đã lo nuôi gà chọi đây

nên kiểm tra tồn tại textbox trước khi tạo object, đoạn code sau là ví dụ ktra tồn tại của textbox chưa
Mã: 
[LEFT][COLOR=#222222][FONT=&amp]Dim TextBox As Shape[/FONT][/COLOR]
[COLOR=#222222][FONT=&amp]On Error Resume Next[/FONT][/COLOR]
[COLOR=#222222][FONT=&amp]Set TextBox = ThisWorkbook.Sheets("Sheet[/FONT][/COLOR][COLOR=#222222][FONT=&amp]1").Shapes[/FONT][/COLOR][COLOR=#222222][FONT=&amp]("txtFullN[/FONT][/COLOR][COLOR=#222222][FONT=&amp]ame")[/FONT][/COLOR]
[COLOR=#222222][FONT=&amp]On Error GoTo 0[/FONT][/COLOR]
[COLOR=#222222][FONT=&amp]If Not TextBox Is Nothing Then MsgBox "txtFullName exists."[/FONT][/COLOR][/LEFT]
Nhấp chuột vào đây để mở rộng...
trong file mình có rồi nhé
Mã: 
Private Sub Insert0(ByVal mObj As String, _
            Optional ByVal Ws As Worksheet, _
            Optional ByVal nObj As String, _
            Optional ByVal mLeft As Double = 10, _
            Optional ByVal mTop As Double = 10, _
            Optional ByVal mWidth As Double = 10, _
            Optional ByVal mHeight As Double = 10)
    Dim Obj As Object 'OLEObject
    Dim oldEvent As Boolean
    'Dim NamesDoiTuong As String
    oldEvent = Application.EnableEvents
    Application.EnableEvents = False
    'NamesDoiTuong = Replace(Replace(NameObj, ".", ""), "Forms", "")
    If Ws Is Nothing Then Set Ws = ActiveSheet
    With Ws
    Dim i As Byte
[COLOR=#ff0000]        'duyet qua het cac doi tuong
        For i = 1 To .Shapes.Count
            'neu doi tuong da ton tai thi thoat, ko chen nua
            If .Shapes.Item(i).Name = nObj Then GoTo Thoat
        Next i[/COLOR]
        'chen doi tuong
        Set Obj = .OLEObjects.Add(ClassType:=mObj, Link:=False, _
                DisplayAsIcon:=False, Left:=mLeft, Top:=mTop, Width:=mWidth, Height:=mHeight)
        With Obj 'an doi tuong di
            '.Name = nObj
            .Visible = False
        End With
    End With
Thoat:
    Application.EnableEvents = oldEvent
    Set Obj = Nothing
    Set Ws = Nothing
End Sub
 
Upvote 0
langtuchungtinh360 đã viết:
trong file mình có rồi nhé
Mã: 
Private Sub Insert0(ByVal mObj As String, _
            Optional ByVal Ws As Worksheet, _
            Optional ByVal nObj As String, _
            Optional ByVal mLeft As Double = 10, _
            Optional ByVal mTop As Double = 10, _
            Optional ByVal mWidth As Double = 10, _
            Optional ByVal mHeight As Double = 10)
    Dim Obj As Object 'OLEObject
    Dim oldEvent As Boolean
    'Dim NamesDoiTuong As String
    oldEvent = Application.EnableEvents
    Application.EnableEvents = False
    'NamesDoiTuong = Replace(Replace(NameObj, ".", ""), "Forms", "")
    If Ws Is Nothing Then Set Ws = ActiveSheet
    With Ws
    Dim i As Byte
[COLOR=#ff0000]        'duyet qua het cac doi tuong
        For i = 1 To .Shapes.Count
            'neu doi tuong da ton tai thi thoat, ko chen nua
            If .Shapes.Item(i).Name = nObj Then GoTo Thoat
        Next i[/COLOR]
        'chen doi tuong
        Set Obj = .OLEObjects.Add(ClassType:=mObj, Link:=False, _
                DisplayAsIcon:=False, Left:=mLeft, Top:=mTop, Width:=mWidth, Height:=mHeight)
        With Obj 'an doi tuong di
            '.Name = nObj
            .Visible = False
        End With
    End With
Thoat:
    Application.EnableEvents = oldEvent
    Set Obj = Nothing
    Set Ws = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...

thế thì tốt rùi, vì bạn hỏi
langtuchungtinh360 đã viết:
...
vậy làm sao để kiểm tra textbox có tồn tại không......
Nhấp chuột vào đây để mở rộng...

nên mới có trả lời trên
 
Upvote 0
Các bác cho em hỏi cái code này với.
Em muốn tạo 1 macro phím tắt là Ctrl + T, khi nhấn phím tắt này thì ô đang được chọn sẽ được paste format từ ô A1 của sheet 2 sang.
 
Upvote 0
Thì bạn tiến hành ghi các lệnh về Format Sheet2.[A1] vô 1 macro;

Sau đó gán fím nóng cho nó như bạn muốn.

Tiếp theo là macro sự kiện tại ô mà bạn muốn chép Format từ Sheet2.[A1]
 
Upvote 0
- Các bác cho e hỏi về code kiểm tra CheckBox đã được Tích hay chưa ạ

- Tại TextBox 5 e nhập như sau:

Private Sub TextBox5_Change()
With Me
If .CheckBox1.Enabled = True Then
.....
End If
End Sub

Nhưnh hình như cái bôi đậm e thấy nó k đúng thì phải. Vì lúc nào cũng là True hết ạ
 

File đính kèm

  • Untitled.png
    Untitled.png
    784 bytes · Đọc: 40
Upvote 0
Kiểm tra thuộc tính Value (so sánh với xlOn)
Thuọc tính Enabled dùng để báo cho Form biết nó có sử dụng hay không. Nếu Enabled = false thì checkbox sẽ bị mờ (greyed out), và ngừoi dùng sẽ chẳng tick hay unltick gì được cả.
 
Upvote 0
VetMini đã viết:
Kiểm tra thuộc tính Value (so sánh với xlOn)
Thuọc tính Enabled dùng để báo cho Form biết nó có sử dụng hay không. Nếu Enabled = false thì checkbox sẽ bị mờ (greyed out), và ngừoi dùng sẽ chẳng tick hay unltick gì được cả.
Nhấp chuột vào đây để mở rộng...

E làm được rùi. Thanks bác :D
 
Upvote 0
Bạn nào biết xin chỉ dùm ngôn ngữ sau là ngôn ngữ Gì ...Mình nghi là Delphi quá
Mã: 
Object acAddObjectForm: TacAddObjectForm
  Left = 345
  Top = 238
  BorderIcons = [biSystemMenu, biMaximize]
  BorderStyle = bsDialog
  Caption = 'Add new object'
  ClientHeight = 396
  ClientWidth = 422
  Color = clBtnFace
  Constraints.MinHeight = 423
  Constraints.MinWidth = 428
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poMainFormCenter
  OnHide = FormHide
  PixelsPerInch = 96
  TextHeight = 13
  Object pcObjects: TPageControl
    Left = 0
    Top = 60
    Width = 422
    Height = 302
    ActivePage = tsSynonyms
    Align = alClient
    TabOrder = 0
    OnChange = pcObjectsChange
    Object tsTables: TTabSheet
      Caption = 'Tables'
      Object lTables: TListView
        Left = 0
        Top = 0
        Width = 414
        Height = 247
        Anchors = [akLeft, akTop, akRight, akBottom]
        Columns = <>
        MultiSelect = True
        ReadOnly = True
        TabOrder = 0
        ViewStyle = vsList
        OnDblClick = lListViewDblClick
      End
      Object cbAddFK: TCheckBox
        Left = 6
        Top = 253
        Width = 406
        Height = 17
        Anchors = [akLeft, akBottom]
        Caption = 'Create links from foreign keys'
        Checked = True
        State = cbChecked
        TabOrder = 1
      End
    End
    Object tsViews: TTabSheet
      Caption = 'Views'
      ImageIndex = 1
      Object lViews: TListView
        Left = 0
        Top = 0
        Width = 414
        Height = 274
        Align = alClient
        Columns = <>
        MultiSelect = True
        ReadOnly = True
        TabOrder = 0
        ViewStyle = vsList
        OnDblClick = lListViewDblClick
      End
    End
    Object tsProcedures: TTabSheet
      Caption = 'Procedures'
      ImageIndex = 2
      Object lProcedures: TListView
        Left = 0
        Top = 0
        Width = 414
        Height = 274
        Align = alClient
        Columns = <>
        ReadOnly = True
        TabOrder = 0
        ViewStyle = vsList
        OnDblClick = lListViewDblClick
      End
    End
    Object tsSynonyms: TTabSheet
      Caption = 'Synonyms'
      ImageIndex = 3
      Object lSynonyms: TListView
        Left = 0
        Top = 0
        Width = 414
        Height = 274
        Align = alClient
        Columns = <>
        ReadOnly = True
        TabOrder = 0
        ViewStyle = vsList
        OnDblClick = lListViewDblClick
      End
    End
  End
  Object pTop: TPanel
    Left = 0
    Top = 0
    Width = 422
    Height = 60
    Align = alTop
    TabOrder = 1
    Object lInstruction: TLabel
      Left = 8
      Top = 6
      Width = 390
      Height = 13
      Anchors = [akLeft, akTop, akRight]
      Caption =
        'Select an object and press the "Add Object" button to add new ob' +
        'ject to the query'
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Tahoma'
      Font.Style = []
      ParentFont = False
      WordWrap = True
    End
    Object lFilterBySchema: TLabel
      Left = 8
      Top = 36
      Width = 147
      Height = 13
      Caption = 'Filter objects by Schema name:'
    End
    Object cbSchemas: TComboBox
      Left = 163
      Top = 32
      Width = 253
      Height = 21
      Style = csDropDownList
      Anchors = [akLeft, akTop, akRight]
      ItemHeight = 0
      TabOrder = 0
      OnChange = cbSchemasChange
    End
  End
  Object pBottom: TPanel
    Left = 0
    Top = 362
    Width = 422
    Height = 34
    Align = alBottom
    TabOrder = 2
    Object bAdd: TButton
      Left = 4
      Top = 4
      Width = 120
      Height = 25
      Anchors = [akLeft, akBottom]
      Caption = '&Add Object'
      Enabled = False
      TabOrder = 0
      OnClick = bAddClick
    End
    Object bClose: TButton
      Left = 340
      Top = 4
      Width = 75
      Height = 25
      Anchors = [akRight, akBottom]
      Cancel = True
      Caption = 'Close'
      Default = True
      TabOrder = 1
      OnClick = bCloseClick
    End
  End
  Object Localizer: TacQBLocalizerForm
    Properties.Strings = (
      'Caption'
      'pcObjects.tsTables.Caption'
      'pcObjects.tsTables.cbAddFK.Caption'
      'pcObjects.tsViews.Caption'
      'pcObjects.tsProcedures.Caption'
      'pcObjects.tsSynonyms.Caption'
      'pTop.lInstruction.Caption'
      'pTop.lFilterBySchema.Caption'
      'pBottom.bAdd.Caption'
      'pBottom.bClose.Caption')
    Left = 16
    Top = 94
  End
End
 
Upvote 0
Cho em hỏi chút là hàm Countif có sử dụng được ở dạng mảng trong vba không ạ? Nếu có thì cách viết như thế nào?

Em dùng code này nhưng không biết sai ở đâu:

PHP: 
     'Phat hien trung lap

Set Dic1 = CreateObject("Scripting.Dictionary")

 Arr() = [C9].Resize(Rws).Value

 ReDim dArr(1 To Rws, 1 To 1)

 For J = 1 To UBound(Arr())

    If Not IsEmpty(Arr(J, 1)) And Not Dic1.exists(Arr(J, 1)) Then

            J = J + 1

             Dic1.Add Arr(J, 1), J

             dArr(J, 1) = Arr(J, 1)

    Else

             dArr(J, 1) = 2

    End If

 Next J

 [A9].Resize(Rws).Value = dArr()
 
Lần chỉnh sửa cuối:
Upvote 0
tueyennhi đã viết:
Cho em hỏi chút là hàm Countif có sử dụng được ở dạng mảng trong vba không ạ? Nếu có thì cách viết như thế nào?

Em dùng code này nhưng không biết sai ở đâu:
PHP: 
     'Phat hien trung lap
Set Dic1 = CreateObject("Scripting.Dictionary")
 Arr() = [C9].Resize(Rws).Value
 ReDim dArr(1 To Rws, 1 To 1)
 For J = 1 To UBound(Arr())
    If Not IsEmpty(Arr(J, 1)) And Not Dic1.exists(Arr(J, 1)) Then
            J = J + 1
             Dic1.Add Arr(J, 1), J
             dArr(J, 1) = Arr(J, 1)
    Else
             dArr(J, 1) = 2
    End If
 Next J
 [A9].Resize(Rws).Value = dArr()
Nhấp chuột vào đây để mở rộng...
dùng Dic tương đối khó, phải làm nhiều mới quen được, bạn xem code cột A đếm số lần trùng của cột C
Mã: 
Set dic1 = CreateObject("Scripting.Dictionary")
 Arr() = [C9].Resize(Rws).Value
' gan so lan trung vao Item cua Dic1
 For J = 1 To UBound(Arr())
    If Not IsEmpty(Arr(J, 1)) Then
      If Not dic1.exists(Arr(J, 1)) Then
        dic1.Add Arr(J, 1), 1
      Else
        dic1.Item(Arr(J, 1)) = dic1.Item(Arr(J, 1)) + 1
      End If
    End If
 Next J
'gan so lan trung vao Darr
 ReDim Darr(1 To Rws, 1 To 1)
 For J = 1 To UBound(Darr())
    If Not IsEmpty(Arr(J, 1)) Then Darr(J, 1) = dic1.Item(Arr(J, 1))
 Next J
[A9].Resize(Rws).Value = Darr()
 
Upvote 0
HieuCD đã viết:
dùng Dic tương đối khó, phải làm nhiều mới quen được, bạn xem code cột A đếm số lần trùng của cột C
Mã: 
Set dic1 = CreateObject("Scripting.Dictionary")
 Arr() = [C9].Resize(Rws).Value
' gan so lan trung vao Item cua Dic1
 For J = 1 To UBound(Arr())
    If Not IsEmpty(Arr(J, 1)) Then
      If Not dic1.exists(Arr(J, 1)) Then
        dic1.Add Arr(J, 1), 1
      Else
        dic1.Item(Arr(J, 1)) = dic1.Item(Arr(J, 1)) + 1
      End If
    End If
 Next J
'gan so lan trung vao Darr
 ReDim Darr(1 To Rws, 1 To 1)
 For J = 1 To UBound(Darr())
    If Not IsEmpty(Arr(J, 1)) Then Darr(J, 1) = dic1.Item(Arr(J, 1))
 Next J
[A9].Resize(Rws).Value = Darr()
Nhấp chuột vào đây để mở rộng...

Ồ được rồi, cảm ơn HieuCD nhé :)
 
Upvote 0
Cho em hỏi

Rws = [B9].CurrentRegion.Rows.Count - 8
Cells(Rws + 9, 1).Resize(65000, 45).Delete

Em dùng để delete các ô kẻ định dạng... mà không có dữ liệu nhưng càng chạy lệnh file càng phình to hơn. Kiểm tra dòng cuối cùng của sheet thì ban đầu giả sử chưa chạy lệnh là A, sau khi chạy lệnh dòng cuối cùng là A+65000. Tại sao lại như vậy nhỉ. Có cách nào để xóa toàn bộ ô cột định dạng sau dòng dữ liệu cuối cùng không ạ?
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

S
cần xử lý dữ liệu trùng nhau bằng VBA
Trả lời
1
Đọc
12
HUONGHCKT
H
N
Tạo file lưu trữ dữ liệu tự động trên excel. (1 người xem)
Trả lời
7
Đọc
99
le_vis
L
N
  • Question Question
Tạo file lưu trữ dự liệu tự động
Trả lời
6
Đọc
119
Hoàng Tuấn 868
H
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
9
Đọc
505
ongke0711
ongke0711
Ả
Cách tạo list Data validation không qua trung gian (1 người xem)
Trả lời
45
Đọc
7K
HOADINH84
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
395
Đọc
47K
phamvanquoc.hanamninh
P
V
  • Question Question
Tạo dữ liệu random cho từng sheet dựa theo dữ liệu có sẵn
Trả lời
3
Đọc
131
HieuCD
H
hieuxd
  • Question Question
Khi nhập dữ liệu tự động chèn thêm dòng khi số dòng trong bảng mẫu sắp hết
Trả lời
26
Đọc
25K
dungpham01
D
D
in ra bị thiếu chữ
Trả lời
4
Đọc
96
dankedun
D
Momominh
Hỏi công thức tìm tuần thiếu hàng
Trả lời
1
Đọc
75
hoangtuaotrang_hp_vn
H
2
EM MUỐN TẠO MA TRẬN BIẾN ĐỔI GIÁ TRỊ PHẦN TỬ NGẪU NHIÊN
Trả lời
2
Đọc
70
ptm0412
ptm0412
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định
Trả lời
34
Đọc
2K
Emyeuexcel
Emyeuexcel
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb
Trả lời
6
Đọc
294
YêuCN
Y
S
Mở 2 cửa sổ riêng biệt
Trả lời
31
Đọc
24K
ThanhNgan240723
T
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL
    • Buồn
Trả lời
57
Đọc
20K
vovietdung261016
V
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Thích
    • Cảm ơn
Trả lời
7
Đọc
1K
PhanTuHuong
PhanTuHuong
huuthang_bd
Add in SwitchSheet: Quay lại các sheet đã xem trước đó bằng phím tắt
    • Thích
    • Yêu thích
2
Trả lời
146
Đọc
43K
phong_codon
P
N
  • Question Question
Hỗ trợ tiếng việt trong macro
Trả lời
14
Đọc
613
Quang_Hải
Quang_Hải
N
Cài phần mềm đọc số ra chữ
Trả lời
2
Đọc
147
Nguyễn Duy Tuân
Nguyễn Duy Tuân
T
Em cần hỗ trợ tách nhiều file và đặt tên theo quy ước chung từ bảng 01 excel có sẳng
Trả lời
1
Đọc
126
HUONGHCKT
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

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

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom