Chuyên đề giải đáp những thắc mắc về code VBA

[maytinhvp01]

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]

 

[langtuchungtinh360]

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

 

[ndu96081631]

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

Thêm code này vào UserForm thử xem:

Private Sub UserForm_Terminate()
  End
End Sub

 

[langtuchungtinh360]

Thêm code này vào UserForm thử xem:

Private Sub UserForm_Terminate()
  End
End Sub

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

 

[keke355992]

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 ạ )

 

[Ba 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 ạ )

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

 

[dynamic503]

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)

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)

 

[huuthang_bd]

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

Làm vầy được không.

 

[tueyennhi]

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:

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!

 

[ndu96081631]

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:

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!

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:

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:

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?

 

[doveandrose]

Tại sao không nghĩ đến việc chọn sheet bằng ComboBox, ListBox gì gì đó cho khỏe thân?

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

 

[tueyennhi]

Cảm ơn thầy ndu, em làm được rồi

 

[tueyennhi]

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:

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:

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?

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.

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

 

[Ba Tê]

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:

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.

 

[tueyennhi]

Cảm ơn anh Ba Tê nhé, em làm được rồi anh ạ!

 

[tueyennhi]

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é.

 

[lee hoan]

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 ạ

 

[tueyennhi]

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 ạ?

 

[befaint]

Câu lệnh trên có thể giảm bớt if đi được không ạ?

T = Arr(J, 1)
dArr(J, 1) = IIf(T = "Senior Manager", "A", IIf(T = "Manager", "B", IIf(T = "Ast Manager", "C", "D")))

 

[tueyennhi]

T = Arr(J, 1)
dArr(J, 1) = IIf(T = "Senior Manager", "A", IIf(T = "Manager", "B", IIf(T = "Ast Manager", "C", "D")))

Cảm ơn Befaint. Năm mới chúc bạn và gia đình luôn luôn mạnh khỏe, tràn đầy niềm vui

 

[VetMini]

@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.

= 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.