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

[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]

 

[Quang_Hải]

Em đang tập viết code VBA. Nhưng nói chung còn quá gà, túm lại là còn chưa hiểu. Mong được mọi người giúp
Private Sub Thongke()
Dim dem As Long, Dic As Object, sArr, dArr(), J As Long, K As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet("Tong_hop")
dem = [BL65000].End(xlUp).Row
For I = 1 To er
If Cells(I, 1) <> "" Then
.Cells(I, 1) = Application.[SUM((Tong_hop!dem>=0)*(Tong_hop!dem<4)]
.Cells(I, 1) = Application.[SUM((Tong_hop!dem>=4)*(Tong_hop!dem<5)]
.Cells(I, 1) = Application.[SUM((Tong_hop!dem>=5)*(Tong_hop!dem<6)]
.Cells(I, 1) = Application.[SUM((Tong_hop!dem>=6)*(Tong_hop!dem<7)]
.Cells(I, 1) = Application.[SUM((Tong_hop!dem>=7)*(Tong_hop!dem<8)]
.Cells(I, 1) = Application.[SUM((Tong_hop!dem>=8)*(Tong_hop!dem<9)]
.Cells(I, 1) = Application.[SUM((Tong_hop!dem>=9)*(Tong_hop!dem<10)]
End If
Next I
End With
End Sub
Chẳng biết kết hợp làm sao?. Làm mãi chẳng được. Muốn gán cho nó vào mảng và dùng vòng lặp để duyệt sau đó lấy kết quả mà chẳng thể làm nổi ..... Rất mong mọi người giúp cho. Thôi thì gửi file đính kèm nhờ mọi người giúp. Xin cảm ơn mọi người rất nhiều.

Code theo file của bạn

Sub thongke()
Dim Sheet(), i As Byte, Result(), j As Long, Source(), Col As Byte, ii As Long, jj As Long
Sheet = Array("Hoc_ky", "Tong_hop")
With Sheets("Bang_Phu")
   .[C2:D1000].ClearContents
   Result = .Range(.[B2], .[B65536].End(3)).Resize(, 3).Value
End With
For i = 0 To UBound(Sheet)
   Col = IIf(i = 0, 28, 65)
   With Sheets(Sheet(i))
      Source = .Range(.Cells(10, Col), .Cells(65536, Col).End(3)).Value
   End With
   For ii = 1 To UBound(Result)
      For jj = 1 To UBound(Source)
         If Source(jj, 1) = Result(ii, 1) Then
            Result(ii, i + 2) = Result(ii, i + 2) + 1
         End If
      Next jj
   Next ii
Next
Sheets("Bang_Phu").[B2].Resize(ii - 1, 3) = Result
End Sub

 

[Thuyanhanoi]

Cảm ơn bạn: Công thức mà mình làm là ở sheet (Bang_phu) rồi, mình không thông kê trên sheet hoc_ky và sheet Tong_hop.

 

[Thuyanhanoi]

Code theo file của bạn

Sub thongke()
Dim Sheet(), i As Byte, Result(), j As Long, Source(), Col As Byte, ii As Long, jj As Long
Sheet = Array("Hoc_ky", "Tong_hop")
With Sheets("Bang_Phu")
   .[C2:D1000].ClearContents
   Result = .Range(.[B2], .[B65536].End(3)).Resize(, 3).Value
End With
For i = 0 To UBound(Sheet)
   Col = IIf(i = 0, 28, 65)
   With Sheets(Sheet(i))
      Source = .Range(.Cells(10, Col), .Cells(65536, Col).End(3)).Value
   End With
   For ii = 1 To UBound(Result)
      For jj = 1 To UBound(Source)
         If Source(jj, 1) = Result(ii, 1) Then
            Result(ii, i + 2) = Result(ii, i + 2) + 1
         End If
      Next jj
   Next ii
Next
Sheets("Bang_Phu").[B2].Resize(ii - 1, 3) = Result
End Sub

Thầy cho em thêm chỗ này với: Với code trên em chạy thấy có vấn đề như sau thầy chỉnh giúp em với: Ví dụ như tại cột loại giỏi; Xuất sắc và yếu. không có HSSV nào thì gán bằng 0. Em cảm ơn nhiều

 

[Quang_Hải]

Thầy cho em thêm chỗ này với: Loại nào không có thì gán bằng 0 giúp em với

Không cố gắng tự vận động thì đến bao giờ mới tự xử được

Sub thongke()
Dim Sheet(), i As Byte, Result(), j As Long, Source(), Col As Byte, ii As Long, jj As Long
Sheet = Array("Hoc_ky", "Tong_hop")
With Sheets("Bang_Phu")
   .[C2:D1000].ClearContents
   Result = .Range(.[B2], .[B65536].End(3)).Resize(, 3).Value
End With
For i = 0 To UBound(Sheet)
   Col = IIf(i = 0, 28, 65)
   With Sheets(Sheet(i))
      Source = .Range(.Cells(10, Col), .Cells(65536, Col).End(3)).Value
   End With
   For ii = 1 To UBound(Result)
      For jj = 1 To UBound(Source)
         If Source(jj, 1) = Result(ii, 1) Then
            Result(ii, i + 2) = Result(ii, i + 2) + 1
         Else
            If Result(ii, i + 2) = 0 Then Result(ii, i + 2) = 0
         End If
      Next jj
   Next ii
Next
Sheets("Bang_Phu").[B2].Resize(ii - 1, 3) = Result
End Sub

 

[Thuyanhanoi]

Không cố gắng tự vận động thì đến bao giờ mới tự xử được

Sub thongke()
Dim Sheet(), i As Byte, Result(), j As Long, Source(), Col As Byte, ii As Long, jj As Long
Sheet = Array("Hoc_ky", "Tong_hop")
With Sheets("Bang_Phu")
   .[C2:D1000].ClearContents
   Result = .Range(.[B2], .[B65536].End(3)).Resize(, 3).Value
End With
For i = 0 To UBound(Sheet)
   Col = IIf(i = 0, 28, 65)
   With Sheets(Sheet(i))
      Source = .Range(.Cells(10, Col), .Cells(65536, Col).End(3)).Value
   End With
   For ii = 1 To UBound(Result)
      For jj = 1 To UBound(Source)
         If Source(jj, 1) = Result(ii, 1) Then
            Result(ii, i + 2) = Result(ii, i + 2) + 1
         Else
            If Result(ii, i + 2) = 0 Then Result(ii, i + 2) = 0
         End If
      Next jj
   Next ii
Next
Sheets("Bang_Phu").[B2].Resize(ii - 1, 3) = Result
End Sub

Code của thầy đã ok. Em cảm ơn Thầy nhiều. Em bắt đầu tìm hiểu cũng được tới 2 tháng nay mà chưa được gì hì hì ...
- Nhân đây thầy Cho em hỏi với. Thầy có giúp em code (để gán giá trị của mảng vào một hàng bất kỳ) ví dụ trên cột A8 ở sheet Tổng hợp hoặc sheet học kỳ em nhập vào số 50 chẳng hạn thì tại hàng số 50 đó giá trị của mảng ([B2,C8];[B2,D8] của sheet Bang_phu ) được gán vào dòng 50 tương ứng ở các sheet Tong hợp và học kỳ. Em cảm ơn rất nhiều. Mà vấn đề gán giá trí vào một hàng mà ta cho em vẫn chưa tìm thấy trên diễn đàn.

 

[Ba Tê]

Thầy cho em thêm chỗ này với: Với code trên em chạy thấy có vấn đề như sau thầy chỉnh giúp em với: Ví dụ như tại cột loại giỏi; Xuất sắc và yếu. không có HSSV nào thì gán bằng 0. Em cảm ơn nhiều

Với dữ liệu thật của bạn thì tôi viết code "dài thoòng" này hy vọng bạn xài được cho file thật của bạn, chứ bạn đưa file không thật rồi bảo là "code không chạy" mệt lắm.

Public Sub TK_BangPhu()Dim ArrHK(), ArrTH(), dArr(), i As Long, XS As String, Gioi As String, Kha As String, TBKha As String, TB As String, Yeu As String, Kem As String
With Sheets("Tong_hop")
    ArrTH = .Range(.[BM10], .[BM65000].End(xlUp)).Value
End With
With Sheets("Hoc_Ky")
    ArrHK = .Range(.[AB10], .[AB65000].End(xlUp)).Value
End With
With Sheets("Bang_phu")
    .Range("C2:D8").Value = 0
    dArr = .Range("C2:D8").Value
    Kem = .[B2].Value
    Yeu = .[B3].Value
    TB = .[B4].Value
    TBKha = .[B5].Value
    Kha = .[B6].Value
    Gioi = .[B7].Value
    XS = .[B8].Value
    For i = 1 To UBound(ArrHK, 1)
        If ArrHK(i, 1) = Kem Then
            dArr(1, 1) = dArr(1, 1) + 1
        ElseIf ArrHK(i, 1) = Yeu Then
            dArr(2, 1) = dArr(2, 1) + 1
        ElseIf ArrHK(i, 1) = TB Then
            dArr(3, 1) = dArr(3, 1) + 1
        ElseIf ArrHK(i, 1) = TBKha Then
            dArr(4, 1) = dArr(4, 1) + 1
        ElseIf ArrHK(i, 1) = Kha Then
            dArr(5, 1) = dArr(5, 1) + 1
        ElseIf ArrHK(i, 1) = Gioi Then
            dArr(6, 1) = dArr(6, 1) + 1
        ElseIf ArrHK(i, 1) = XS Then
            dArr(7, 1) = dArr(7, 1) + 1
        End If
    Next i
    For i = 1 To UBound(ArrTH, 1)
        If ArrTH(i, 1) = Kem Then
            dArr(1, 2) = dArr(1, 2) + 1
        ElseIf ArrTH(i, 1) = Yeu Then
            dArr(2, 2) = dArr(2, 2) + 1
        ElseIf ArrTH(i, 1) = TB Then
            dArr(3, 2) = dArr(3, 2) + 1
        ElseIf ArrTH(i, 1) = TBKha Then
            dArr(4, 2) = dArr(4, 2) + 1
        ElseIf ArrTH(i, 1) = Kha Then
            dArr(5, 2) = dArr(5, 2) + 1
        ElseIf ArrTH(i, 1) = Gioi Then
            dArr(6, 2) = dArr(6, 2) + 1
        ElseIf ArrTH(i, 1) = XS Then
            dArr(7, 2) = dArr(7, 2) + 1
        End If
    Next i
    .[C2:D8].Value = dArr
End With
End Sub

 

[Thuyanhanoi]

Với dữ liệu thật của bạn thì tôi viết code "dài thoòng" này hy vọng bạn xài được cho file thật của bạn, chứ bạn đưa file không thật rồi bảo là "code không chạy" mệt lắm.

Public Sub TK_BangPhu()Dim ArrHK(), ArrTH(), dArr(), i As Long, XS As String, Gioi As String, Kha As String, TBKha As String, TB As String, Yeu As String, Kem As String
With Sheets("Tong_hop")
    ArrTH = .Range(.[BM10], .[BM65000].End(xlUp)).Value
End With
With Sheets("Hoc_Ky")
    ArrHK = .Range(.[AB10], .[AB65000].End(xlUp)).Value
End With
With Sheets("Bang_phu")
    .Range("C2:D8").Value = 0
    dArr = .Range("C2:D8").Value
    Kem = .[B2].Value
    Yeu = .[B3].Value
    TB = .[B4].Value
    TBKha = .[B5].Value
    Kha = .[B6].Value
    Gioi = .[B7].Value
    XS = .[B8].Value
    For i = 1 To UBound(ArrHK, 1)
        If ArrHK(i, 1) = Kem Then
            dArr(1, 1) = dArr(1, 1) + 1
        ElseIf ArrHK(i, 1) = Yeu Then
            dArr(2, 1) = dArr(2, 1) + 1
        ElseIf ArrHK(i, 1) = TB Then
            dArr(3, 1) = dArr(3, 1) + 1
        ElseIf ArrHK(i, 1) = TBKha Then
            dArr(4, 1) = dArr(4, 1) + 1
        ElseIf ArrHK(i, 1) = Kha Then
            dArr(5, 1) = dArr(5, 1) + 1
        ElseIf ArrHK(i, 1) = Gioi Then
            dArr(6, 1) = dArr(6, 1) + 1
        ElseIf ArrHK(i, 1) = XS Then
            dArr(7, 1) = dArr(7, 1) + 1
        End If
    Next i
    For i = 1 To UBound(ArrTH, 1)
        If ArrTH(i, 1) = Kem Then
            dArr(1, 2) = dArr(1, 2) + 1
        ElseIf ArrTH(i, 1) = Yeu Then
            dArr(2, 2) = dArr(2, 2) + 1
        ElseIf ArrTH(i, 1) = TB Then
            dArr(3, 2) = dArr(3, 2) + 1
        ElseIf ArrTH(i, 1) = TBKha Then
            dArr(4, 2) = dArr(4, 2) + 1
        ElseIf ArrTH(i, 1) = Kha Then
            dArr(5, 2) = dArr(5, 2) + 1
        ElseIf ArrTH(i, 1) = Gioi Then
            dArr(6, 2) = dArr(6, 2) + 1
        ElseIf ArrTH(i, 1) = XS Then
            dArr(7, 2) = dArr(7, 2) + 1
        End If
    Next i
    .[C2:D8].Value = dArr
End With
End Sub

- Đọc cả 2 tháng nay em mới gán được form controls Thầy ạ! mà listbox còn chưa được.
- Em dùng cách gán qua gán lại này là để tổng hợp số lượng xếp loại. Sau đó lại trả lại kết quả vào sheet tương ứng. Nhưng vì chưa biết số lương HSSV là bao nhiều do vậy mới lựa chọn phương án đó. Khi biết được số lượng HSSV cụ thể cuối cùng ở dòng bào nhiêu (vị dụ học sinh cuối cùng nằm ở dòng 100 thì em gán giá trị từ sheet Bang_phu sang là vòa dòng thứ 102) Khi biết được số lượng rồi thì gán trả lại cho nó kết quả tương ứng, mà lại không phải xử lý phông chữ. Nghi vậy mà loay hoay mãi không xong buồn chứ híc híc.

 

[tuyetphale]

Giải thích hộ em code này

Em chưa học qua VBA và các loại code
Em có đăng diễn đàn để xin trợ giúp việc tìm kiếm cách dò tìm nhiều điều kiện và cho ra nhiều kết quả.
Có một bạn chỉ em cách tạo code hàm LietKe nhưng em áp dụng vào những dữ liệu khác không được vì không hiểu code để tuỳ biến
Ai giải thích hộ em, ý nghĩa của từng dòng trong code, em cảm ơn nhiều ạ!

 

[Quang_Hải]

Em chưa học qua VBA và các loại code
Em có đăng diễn đàn để xin trợ giúp việc tìm kiếm cách dò tìm nhiều điều kiện và cho ra nhiều kết quả.
Có một bạn chỉ em cách tạo code hàm LietKe nhưng em áp dụng vào những dữ liệu khác không được vì không hiểu code để tuỳ biến
Ai giải thích hộ em, ý nghĩa của từng dòng trong code, em cảm ơn nhiều ạ!

Với bài này thì chỉ cần 3 dòng code như thế này

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$2" Or Target.Address = "$H$2" Then
   [A3:D10000].AdvancedFilter 2, [G1:H2], [G3:J3]
End If
End Sub

 

[tuyetphale23]

.....

Ai sửa dùm em file này theo cách làm của bác quanghai1969 giùm cái
Vừa save bị lỗi gì đó, mà vừa không chạy code được
Ai có khả năng giúp giùm em cái, em cần gấp

 

[nam_lp86]

Chào các anh/chị , nhờ anh/chị trợ giúp

Hiện tại e có một bảng phiếu in lương cho nhân viên
Các thông tin trong phiếu in lương được chạy bằng hàm vlookup theo mã nhân viên có dạng NSX ( trong đó X = 1, 2, 3 .... n)
Ý tưởng: muốn in nhiều nhân viên cùng một lúc bằng cách nhập mã nhân viên cuối VD NS10 , nhấn vào nút in sẽ in lần lượt từ NS1 -> NS10

Em đã tạo một nút in bằng câu lệnh như bên dưới.

Sheets("luong").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=2

Nhưng mỗi lần in lại phải thay mã nhân viên để in nhân viên tiếp theo. Vậy em phải thêm vòng lặp như thế nào để có thể in tự động lần lượt từng nhân viên ạ!
Em cảm ơn!

 

[dhn46]

Chào các anh/chị , nhờ anh/chị trợ giúp

Hiện tại e có một bảng phiếu in lương cho nhân viên
Các thông tin trong phiếu in lương được chạy bằng hàm vlookup theo mã nhân viên có dạng NSX ( trong đó X = 1, 2, 3 .... n)
Ý tưởng: muốn in nhiều nhân viên cùng một lúc bằng cách nhập mã nhân viên cuối VD NS10 , nhấn vào nút in sẽ in lần lượt từ NS1 -> NS10

Em đã tạo một nút in bằng câu lệnh như bên dưới.

Sheets("luong").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=2

Nhưng mỗi lần in lại phải thay mã nhân viên để in nhân viên tiếp theo. Vậy em phải thêm vòng lặp như thế nào để có thể in tự động lần lượt từng nhân viên ạ!
Em cảm ơn!

Bạn chưa biết lập trình vậy nên sử dụng các công cụ có sẵn. Bạn có thể tham khảo tiện ích in form hàng loạt, link tại chữ ký của tôi. Trong topic có ví dụ về phiếu lương hy vọng sẽ ứng dụng được cho công việc của bạn!

 

[Hoàng Trọng Nghĩa]

Với dữ liệu thật của bạn thì tôi viết code "dài thoòng" này hy vọng bạn xài được cho file thật của bạn, chứ bạn đưa file không thật rồi bảo là "code không chạy" mệt lắm.

Public Sub TK_BangPhu()Dim ArrHK(), ArrTH(), dArr(), i As Long, XS As String, Gioi As String, Kha As String, TBKha As String, TB As String, Yeu As String, Kem As String
With Sheets("Tong_hop")
    ArrTH = .Range(.[BM10], .[BM65000].End(xlUp)).Value
End With
With Sheets("Hoc_Ky")
    ArrHK = .Range(.[AB10], .[AB65000].End(xlUp)).Value
End With
With Sheets("Bang_phu")
    .Range("C2:D8").Value = 0
    dArr = .Range("C2:D8").Value
    Kem = .[B2].Value
    Yeu = .[B3].Value
    TB = .[B4].Value
    TBKha = .[B5].Value
    Kha = .[B6].Value
    Gioi = .[B7].Value
    XS = .[B8].Value
    For i = 1 To UBound(ArrHK, 1)
        If ArrHK(i, 1) = Kem Then
            dArr(1, 1) = dArr(1, 1) + 1
        ElseIf ArrHK(i, 1) = Yeu Then
            dArr(2, 1) = dArr(2, 1) + 1
        ElseIf ArrHK(i, 1) = TB Then
            dArr(3, 1) = dArr(3, 1) + 1
        ElseIf ArrHK(i, 1) = TBKha Then
            dArr(4, 1) = dArr(4, 1) + 1
        ElseIf ArrHK(i, 1) = Kha Then
            dArr(5, 1) = dArr(5, 1) + 1
        ElseIf ArrHK(i, 1) = Gioi Then
            dArr(6, 1) = dArr(6, 1) + 1
        ElseIf ArrHK(i, 1) = XS Then
            dArr(7, 1) = dArr(7, 1) + 1
        End If
    Next i
    For i = 1 To UBound(ArrTH, 1)
        If ArrTH(i, 1) = Kem Then
            dArr(1, 2) = dArr(1, 2) + 1
        ElseIf ArrTH(i, 1) = Yeu Then
            dArr(2, 2) = dArr(2, 2) + 1
        ElseIf ArrTH(i, 1) = TB Then
            dArr(3, 2) = dArr(3, 2) + 1
        ElseIf ArrTH(i, 1) = TBKha Then
            dArr(4, 2) = dArr(4, 2) + 1
        ElseIf ArrTH(i, 1) = Kha Then
            dArr(5, 2) = dArr(5, 2) + 1
        ElseIf ArrTH(i, 1) = Gioi Then
            dArr(6, 2) = dArr(6, 2) + 1
        ElseIf ArrTH(i, 1) = XS Then
            dArr(7, 2) = dArr(7, 2) + 1
        End If
    Next i
    .[C2:D8].Value = dArr
End With
End Sub

Trường hợp như code của bác Ba Tê, vì chỉ so sánh với 1 giá trị, nên em nghĩ là mình dùng Select Case vừa ngắn gọn, vừa chạy nhanh:

Public Sub TK_BangPhu()

    Dim ArrHK(), ArrTH(), dArr()
    Dim XS As String, Gioi As String, Kha As String, TBKha As String, _
        TB As String, Yeu As String, Kem As String
    Dim i As Long
    
    With Sheets("Tong_hop")
        ArrTH = Range(.Range("BM10"), .Range("BM65536").End(xlUp))
    End With

    With Sheets("Hoc_Ky")
        ArrHK = Range(.Range("AB10"), .Range("AB65536").End(xlUp))
    End With
    
    With Sheets("Bang_phu")
        .Range("C2:D8") = 0
        dArr = .Range("C2:D8").Value
        Kem = .Range("B2")
        Yeu = .Range("B3")
        TB = .Range("B4")
        TBKha = .Range("B5")
        Kha = .Range("B6")
        Gioi = .Range("B7")
        XS = .Range("B8")
    End With
    
    For i = 1 To UBound(ArrHK, 1)
        Select Case ArrHK(i, 1)
            Case Kem: dArr(1, 1) = dArr(1, 1) + 1
            Case Yeu: dArr(2, 1) = dArr(2, 1) + 1
            Case TB: dArr(3, 1) = dArr(3, 1) + 1
            Case TBKha: dArr(4, 1) = dArr(4, 1) + 1
            Case Kha: dArr(5, 1) = dArr(5, 1) + 1
            Case Gioi: dArr(6, 1) = dArr(6, 1) + 1
            Case XS: dArr(7, 1) = dArr(7, 1) + 1
        End Select
    Next i
    
    For i = 1 To UBound(ArrTH, 1)
        Select Case ArrTH(i, 1)
            Case Kem: dArr(1, 2) = dArr(1, 2) + 1
            Case Yeu: dArr(2, 2) = dArr(2, 2) + 1
            Case TB: dArr(3, 2) = dArr(3, 2) + 1
            Case TBKha: dArr(4, 2) = dArr(4, 2) + 1
            Case Kha: dArr(5, 2) = dArr(5, 2) + 1
            Case Gioi: dArr(6, 2) = dArr(6, 2) + 1
            Case XS: dArr(7, 2) = dArr(7, 2) + 1
        End Select
    Next i
    
    Sheets("Bang_phu").Range("C2:D8") = dArr
    
End Sub

Nhưng với bài này, mình chỉ dùng công thức (hàm COUNTIF, nếu cần, thêm cái name động) thì OK, khỏi cần "cót két" gì hết á!

 

[VetMini]

Hai cái vòng lặp trên code gần in hệt nhau. Ta có thể hoặc đẩy chúng ra hàm con (gọi 2 lần), hoặn lợi dụng tính chất uyển chuyển của array để gộp code lại.

...
Dim ArrHK(), ArrTH(), dArr(), bdArr(), thArr()
Dim bd as Integer ' loại bảng điểm
Dim sTH as Integer ' số thứ hạng (7)
...
' copy 7 ô xếp điểm sang thArr() - Gioi, Kem, vv...
sTH = UBound(thArr) ' trữ trị này để tránh lặp lại nhiều lần
...

For bd = 1 to 2 ' chạy 2 lượt, 1 = tổng hợp; 2 = học kỳ

if (bd=1) Then
    With Sheets("Tong_hop")
        bdArr = Range(.Range("BM10"), .Range("BM65536").End(xlUp))
    End With
Else
    With Sheets("Hoc_Ky")
        bdArr = Range(.Range("AB10"), .Range("AB65536").End(xlUp))
    End With
End If

For i = 1 To UBound(bdArr, 1) ' vòng lặp qua vùng chứa điểm
    For j = 1 to sTH ' vòng lặp so điểm để tìm hạng
        If (bdArr(i, 1) = thArr(j) Then
            dArr(j, bd) = dArr(j, bd) + 1
            Exit For ' đã có hạng rồi, không cần so nữa
        End If
    Next j
Next i

Next bd

 

[nam_lp86]

Nhờ các anh chị giúp,

Em sử dụng đoạn code sau để hiển thị thông tin sinh nhật sau 1 tháng và thông tin nhân viên muốn tìm kiếm

Sub Sinhnhat()
Dim SrcRng As Range, Crit1 As Range
With Sheets("Data")
Set SrcRng = .Range(.[A7], .[A65536].End(xlUp)).Resize(, 50)
Set Crit1 = .Range("B2:B3")
End With
Sheets("SinhNhat").Range("A7:AX500").Clear
SrcRng.AdvancedFilter 2, Crit1, Sheets("SinhNhat").Range("A7")
Sheets("SinhNhat").Select
End Sub
Sub NhanVien()
Dim SrcRng1 As Range, Crit2 As Range
With Sheets("Data")
Set SrcRng1 = .Range(.[A7], .[A65536].End(xlUp)).Resize(, 50)
Set Crit2 = .Range("C2:C3")
End With
Sheets("NhanVien").Range("A7:AX500").Clear
SrcRng1.AdvancedFilter 2, Crit2, Sheets("NhanVien").Range("A7")
Sheets("NhanVien").Select
End Sub

Không biết em làm sai chỗ nào mà phần sinh nhật thì chạy còn phần nhân viên thì không chạy
Link file: http://www.mediafire.com/download/3cvmb958x4d8xds/formNhanSu.xlsm

 

[rocky_boy0204]

Chào anh chị, nhờ các anh chị giúp em giải thích đoạn code này với, hiện tại công việc của em là lập tiến độ dự án, nên sử dụng một file excel của đàn anh đi trước, nhưng không hiểu ý nghĩa các đoạn code này mong mọi người giúp, em xin chân thành cám ơn.

Sub spandek700()
Sheets("SPANDEK 700").Activate
Range(Cells(5, 1), Cells(100, 11)).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection
.Value = ""
End With
J = 5
For i = 7 To 400
Sheets("MASTER PLAN").Activate
If Cells(i, 10) = "SPANDEK" Then
If Cells(i, 20) <> "DONE" And Cells(i, 11) = "Roll-form at factory" Then
a = Cells(i, 23)
b = Cells(i, 5)
c = Cells(i, 9)
d = Cells(i, 14)
e = Cells(i, 29)
f = Cells(i, 15)
G = Cells(i, 3) 'item code
H = Cells(i, 1) 'project code
K = Cells(i, 19) 'ngay xuong BOQ
Sheets("SPANDEK 700").Activate
Cells(J, 1) = a
Cells(J, 2) = b
Cells(J, 3) = c
Cells(J, 4) = d
Cells(J, 5) = e
Cells(J, 6) = f
Cells(J, 8) = H
Cells(J, 9) = G
Cells(J, 11) = K
J = J + 1
End If
End If
Next i
For i = 7 To 500
Sheets("MASTER PLAN").Activate
If Cells(i, 10) = "KLIPLOK" Then
If Cells(i, 20) <> "DONE" And Cells(i, 11) = "Roll-form at factory" Then
a = Cells(i, 23)
b = Cells(i, 5)
c = Cells(i, 9)
d = Cells(i, 14)
e = Cells(i, 29)
f = Cells(i, 15)
G = Cells(i, 3) 'item code
H = Cells(i, 1) 'project code
K = Cells(i, 19) 'ngay xuong BOQ
Sheets("SPANDEK 700").Activate
Cells(J, 1) = a
Cells(J, 2) = b
Cells(J, 3) = c
Cells(J, 4) = d
Cells(J, 5) = e
Cells(J, 6) = f
Cells(J, 8) = H
Cells(J, 9) = G
Cells(J, 11) = K
J = J + 1
End If
End If
Next i
Sheets("SPANDEK 700").Activate
End Sub
Sub resetsp700()
Sheets("CC SPANDEK 700").Activate
Range(Cells(5, 8), Cells(256, 256)).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection
.Value = ""
End With
End Sub

 

[mhieuit]

Em có đoạn code VBA bên dưới, nhờ ACE GPE giải thích giúp em với

Sub UpdatePT_AllShts()
Dim pt As PivotTable
For Each ws In Sheets
For Each pt In ws.PivotTables
ws.PivotTables(pt.Name).PivotCache.Refresh
Next pt
Next ws
End Sub

Thank all!

 

[Hoàng Trọng Nghĩa]

Em có đoạn code VBA bên dưới, nhờ ACE GPE giải thích giúp em với

Sub UpdatePT_AllShts()
Dim pt As PivotTable
For Each ws In Sheets
For Each pt In ws.PivotTables
ws.PivotTables(pt.Name).PivotCache.Refresh
Next pt
Next ws
End Sub

Thank all!

Đây là một thủ tục để Refresh các PivotTable ở các sheet.

Với thủ tục này còn thiếu khai báo một biến WorkSheet: ws

Dòng For đầu tiên duyệt qua các Worksheet.

Dòng For thứ 2 duyệt qua các Pivot trong sheet được duyệt qua

Dòng trong vòng lặp duyệt qua là mỗi Pivot thực thi lệnh Refresh

Các Next lần lượt duyệt qua hết các Pivot table rồi duyệt qua các sheet khác cho đến hết.

Code chỉ đơn giản vậy thôi.

 

[mhieuit]

Sub UpdatePT_AllShts()
Dim pt As PivotTable
Dim ws As Worksheet
For Each ws In Sheets
For Each pt In ws.PivotTables
ws.PivotTables(pt.Name).PivotCache.Refresh
Next pt
Next ws
End Sub

Dòng code em in đậm là đúng phải không anh,
code (pt.Name) trong ws.PivotTables(pt.Name).PivotCache.Refresh là gì vậy anh.

Thank.

 

[Hoàng Trọng Nghĩa]

Sub UpdatePT_AllShts()
Dim pt As PivotTable
Dim ws As Worksheet
For Each ws In Sheets
For Each pt In ws.PivotTables
ws.PivotTables(pt.Name).PivotCache.Refresh
Next pt
Next ws
End Sub

Dòng code em in đậm là đúng phải không anh,
code (pt.Name) trong ws.PivotTables(pt.Name).PivotCache.Refresh là gì vậy anh.

Thank.

Một trong các Worksheet Method có PivotTables và đối số của nó phải là một Index (có thể là một tên của Pvtbl hoặc có thể là một chỉ số của Pvtbl)

Một trong các phương thức của PivotTables là PivotCache v.v...

Để biết thêm chi tiết, bạn đặt con trỏ đến một phương thức nào đó rồi nhấn F1 để được Help hướng dẫn cụ thể cho bạn (nếu bạn biết tiếng Anh).

 

[maytinhvp01]

Chính xác ban đầu giá trị = 0 , mà vụ này bạn dùng worksheetFunction.Max(ran) là được mà !

p/s : bạn mới vào diễn đàn, + mới học vba , mình có chút kinh nghiệm học tập chia sẻ như sau :
*các cụ có câu "học thầy không tày học bạn " <--- bạn cố gắng giao lưu , nhiệt tình , sôi nổi trên GPE,
* Anh ndu và anh Nghĩa là các thành viên có tên tuổi và số má trên diễn đàn, những bài viết nhận xét ,góp ý của các anh ý đều có giá trị nhất định đấy bạn ah

Hôm nay đọc lại. Lần nữa cảm ơn bạn và AC trên diễn đàn rất nhiều.Nhất định găn bó với GPE vì cũng là đam mê...

 

[tiendungnst]

Tôi có một đoạn code sau:

Private Sub cmdThem_Click()Dim RowCount As Long
Dim ctl As Control
Range("BB2:BH2").ClearContents
'Write data to worksheet
RowCount = Worksheets("THULY").Range("BB1").CurrentRegion.Row s.Count
With Worksheets("THULY").Range("BB1")
.Offset(RowCount, 0).Value = Me.cbxNguoinhanBC.Value
.Offset(RowCount, 1).Value = Me.txtNguoilapBC.Value
.Offset(RowCount, 2).Value = Me.txtNguoiduyetBC.Value
.Offset(RowCount, 3).Value = Me.cbxChucdanhduyetBC.Value
.Offset(RowCount, 4).Value = Me.txtNgaylapBC.Value
.Offset(RowCount, 5).Value = Me.txtSothangBC.Value
.Offset(RowCount, 6).Value = Me.txtThoigianBC.Value
End With
Unload Me
End Sub

Nhờ GPE hướng dẫn cách giúp để đoạn code trên (phần chữ màu đỏ) không Clear tất cả thông tin ở Range BB2:BH2
Mà yêu cầu là nó chỉ Replace cho những thông tin nào có thay đổi ở Range BB2:BH2
Cảm ơn mọi người ah!

 

[nguyen.sang67]

em cũng có câu hỏi muốn thầy giải thích ạ
label.Caption = Format(listbox.ListCount, "#,##0")
nhờ thầy giải thích code này hộ em với

 

[Hoàng Trọng Nghĩa]

em cũng có câu hỏi muốn thầy giải thích ạ
label.Caption = Format(listbox.ListCount, "#,##0")
nhờ thầy giải thích code này hộ em với

Trong câu lệnh trên có 2 Controls, có thể là cái tên, nhưng tạm gọi nó là controls Label và controls ListBox. Khi viết gì đó trên Label thì thuộc tính này gọi là Caption; khi đếm số hàng của ListBox thì ListCount là thuộc tính của nó; Format là hàm định dạng số thành một chuỗi có cấu trúc là Format(Number, FormatType).

 

[Hoàng Trọng Nghĩa]

Tôi có một đoạn code sau:


Nhờ GPE hướng dẫn cách giúp để đoạn code trên (phần chữ màu đỏ) không Clear tất cả thông tin ở Range BB2:BH2
Mà yêu cầu là nó chỉ Replace cho những thông tin nào có thay đổi ở Range BB2:BH2
Cảm ơn mọi người ah!

Nhìn code, tôi thấy không cần Clear thì nó cũng đã thay đổi toàn bộ Range BB2:BH2 này rồi. Vậy cho nên xóa hẳn luôn cái Range("BB2:BH2").ClearContents này cũng được.

 

[tiendungnst]

Nhìn code, tôi thấy không cần Clear thì nó cũng đã thay đổi toàn bộ Range BB2:BH2 này rồi. Vậy cho nên xóa hẳn luôn cái Range("BB2:BH2").ClearContents này cũng được.

Nếu yêu cầu đặc ra là không phải thay đổi toàn bộ Range BB2:BH2, mà chỉ thay đổi những thông tin nào mới được nhập (nếu có) trong Range BB2:BH2 thì phải chỉnh sửa code như thế nào ah?

 

[Hoàng Trọng Nghĩa]

Nếu yêu cầu đặc ra là không phải thay đổi toàn bộ Range BB2:BH2, mà chỉ thay đổi những thông tin nào mới được nhập (nếu có) trong Range BB2:BH2 thì phải chỉnh sửa code như thế nào ah?

Với RowCount = 1

With Worksheets("THULY").Range("BB1")
BB2: .Offset(RowCount, 0).Value = Me.cbxNguoinhanBC.Value
BC2: .Offset(RowCount, 1).Value = Me.txtNguoilapBC.Value
BD2: .Offset(RowCount, 2).Value = Me.txtNguoiduyetBC.Value
BE2: .Offset(RowCount, 3).Value = Me.cbxChucdanhduyetBC.Value
BF2: .Offset(RowCount, 4).Value = Me.txtNgaylapBC.Value
BG2: .Offset(RowCount, 5).Value = Me.txtSothangBC.Value
BH2: .Offset(RowCount, 6).Value = Me.txtThoigianBC.Value

Các cell màu đỏ tương ứng với các dòng code đấy, bạn muốn để dòng nào và xóa dòng nào tùy bạn!

 

[tiendungnst]

Với RowCount = 1

With Worksheets("THULY").Range("BB1")
BB2: .Offset(RowCount, 0).Value = Me.cbxNguoinhanBC.Value
BC2: .Offset(RowCount, 1).Value = Me.txtNguoilapBC.Value
BD2: .Offset(RowCount, 2).Value = Me.txtNguoiduyetBC.Value
BE2: .Offset(RowCount, 3).Value = Me.cbxChucdanhduyetBC.Value
BF2: .Offset(RowCount, 4).Value = Me.txtNgaylapBC.Value
BG2: .Offset(RowCount, 5).Value = Me.txtSothangBC.Value
BH2: .Offset(RowCount, 6).Value = Me.txtThoigianBC.Value

Các cell màu đỏ tương ứng với các dòng code đấy, bạn muốn để dòng nào và xóa dòng nào tùy bạn!

Đoạn Code này em chạy để nhập dữ liệu từ Form ah, làm theo cách của Bác thì nó vẫn xóa những thông tin cũ và nhập thông tin mới theo Cell tương ứng ah.
Nhu cầu của em là Thông tin trước đó đã được nhập từ Form đầy đủ, đến kỳ báo cáo sau chỉ có nhu cầu thay đổi thoigianBC (BH2) và NgaylapBC (BF2) còn các thông tin ở Cell khác thì vẫn giữ nội dung cũ không có thay đổi gì nên không phải nhập lại.
Có nghĩa là chỉnh sửa Code như thế nào để khi nhập thông tin từ Form để đáp ứng yêu cầu: nếu Cell nào có thông tin mới thì thay thế, nếu Cell nào không có thay đổi giữ lại thông tin cũ mà không bị xóa ah?

 

[Hoàng Trọng Nghĩa]

Đoạn Code này em chạy để nhập dữ liệu từ Form ah, làm theo cách của Bác thì nó vẫn xóa những thông tin cũ và nhập thông tin mới theo Cell tương ứng ah.
Nhu cầu của em là Thông tin trước đó đã được nhập từ Form đầy đủ, đến kỳ báo cáo sau chỉ có nhu cầu thay đổi thoigianBC (BH2) và NgaylapBC (BF2) còn các thông tin ở Cell khác thì vẫn giữ nội dung cũ không có thay đổi gì nên không phải nhập lại.
Có nghĩa là chỉnh sửa Code như thế nào để khi nhập thông tin từ Form để đáp ứng yêu cầu: nếu Cell nào có thông tin mới thì thay thế, nếu Cell nào không có thay đổi giữ lại thông tin cũ mà không bị xóa ah?

Cho tôi hỏi, bạn chỉ nhập mỗi hàng 2? Nếu thay đổi thì chỉ thay đổi ở các cell thuộc hàng này và không thay đổi thì vẫn giữ lại?

 

[tiendungnst]

Cho tôi hỏi, bạn chỉ nhập mỗi hàng 2? Nếu thay đổi thì chỉ thay đổi ở các cell thuộc hàng này và không thay đổi thì vẫn giữ lại?

Đúng rồi ah, thông tin chỉ nhập vào hàng 2 (từ BB2 đến BH2) thôi ah, nếu có thông tin mới cần thay đổi thì cũng chỉ thay đổi ở hàng số 2 này, nhưng có thể chỉ có 1 Cell thay đổi hoặc tất cả các Cell của hàng 2 này thay đổi ah (có nghĩa là có thể thay đổi tùy ý hoặc không). Và nếu có thay đổi ở Cell nào thì lấy thông tin mới, nếu ko có thông tin mới thì vẫn giữ lại.

 

[Hoàng Trọng Nghĩa]

Đúng rồi ah, thông tin chỉ nhập vào hàng 2 (từ BB2 đến BH2) thôi ah, nếu có thông tin mới cần thay đổi thì cũng chỉ thay đổi ở hàng số 2 này, nhưng có thể chỉ có 1 Cell thay đổi hoặc tất cả các Cell của hàng 2 này thay đổi ah (có nghĩa là có thể thay đổi tùy ý hoặc không). Và nếu có thay đổi ở Cell nào thì lấy thông tin mới, nếu ko có thông tin mới thì vẫn giữ lại.

Vậy thì thủ tục của bạn như thế này đi:

Private Sub cmdThem_Click()
    Dim c As Byte
    Dim ArrSheet(), ArrControls()
    ArrSheet = Sheets("THULY").Range("BB2:BH2")
    ArrControls = Array(cbxNguoinhanBC, txtNguoilapBC, txtNguoiduyetBC, _
                        cbxChucdanhduyetBC, txtNgaylapBC, txtSothangBC, _
                        txtThoigianBC)
    For c = 1 To 7
        If ArrControls(c - 1).Value > "" Then
            ArrSheet(c) = ArrControls(c - 1).Value
        End If
    Next
    Worksheets("THULY").Range("BB2:BH2") = ArrSheet
    Unload Me
End Sub

 

[nguyen.sang67]

Trong câu lệnh trên có 2 Controls, có thể là cái tên, nhưng tạm gọi nó là controls Label và controls ListBox. Khi viết gì đó trên Label thì thuộc tính này gọi là Caption; khi đếm số hàng của ListBox thì ListCount là thuộc tính của nó; Format là hàm định dạng số thành một chuỗi có cấu trúc là Format(Number, FormatType).

cám ơn thầy đã giải thích hộ em. nhưng nếu em muốn tính tổng số lượng của 1 cột trong listbox và hiển thị ra Label thì phải làm sao ạ.ví dụ như cột thứ 7.nhờ thầy giúp ạ

 

[Hoàng Trọng Nghĩa]

cám ơn thầy đã giải thích hộ em. nhưng nếu em muốn tính tổng số lượng của 1 cột trong listbox và hiển thị ra Label thì phải làm sao ạ.ví dụ như cột thứ 7.nhờ thầy giúp ạ

Rất dễ bạn à. Dùng thủ tục này:

Giả sử có 1 ListBox1 và 1 Label1 thì code sẽ như sau:

Sub TongCot7()
    Dim r As Long, c As Long, SumCot7 As Double
    c = ListBox1.ListCount
    If c > 0 Then
        For r = 0 To c - 1
            SumCot7 = SumCot7 + ListBox1.List(r, 6)
        Next
    End If
    Label1.Caption = Format(SumCot7, "#,##0")
End Sub

 

[nguyen.sang67]

Rất dễ bạn à. Dùng thủ tục này:

Giả sử có 1 ListBox1 và 1 Label1 thì code sẽ như sau:

Sub TongCot7()
    Dim r As Long, c As Long, SumCot7 As Double
    c = ListBox1.ListCount
    If c > 0 Then
        For r = 0 To c - 1
            SumCot7 = SumCot7 + ListBox1.List(r, 6)
        Next
    End If
    Label1.Caption = Format(SumCot7, "#,##0")
End Sub

em có file nhờ thầy chỉnh sưa dùm em.sẵn tiện chỉ em cách tạo tiêu đề trong litsbox theo từng combobox nha.cám ơn thầy nhìu

 

[mhieuit]

chào cả nhà,
em có 1 đoạn code, run bi fail, không biết fix thê nào, nhờ các Thầy và bậc đàn anh help với:

Sub master_format()
Dim ws As Worksheet
Set ws = Sheets("RvMasterPickTask")
ws.Columns("B").ColumnWidth = 13
ws.Columns("E").ColumnWidth = 31.8
ws.Columns("B:I").Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 12
End With
With ws.PageSetup
.RightHeader = "Page &P of &N"
End With
ws.Range("A10:A2000").RowHeight = 13.5 'chua xac dinh duoc vung chua du lieu
ws.Columns("K:L").EntireColumn.Hidden = True
End Sub

 

[Quang_Hải]

chào cả nhà,
em có 1 đoạn code, run bi fail, không biết fix thê nào, nhờ các Thầy và bậc đàn anh help với:

Sub master_format()
Dim ws As Worksheet
Set ws = Sheets("RvMasterPickTask")
ws.Columns("B").ColumnWidth = 13
ws.Columns("E").ColumnWidth = 31.8
ws.Columns("B:I").Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 12
End With
With ws.PageSetup
.RightHeader = "Page &P of &N"
End With
ws.Range("A10:A2000").RowHeight = 13.5 'chua xac dinh duoc vung chua du lieu
ws.Columns("K:L").EntireColumn.Hidden = True
End Sub

Căn bản thì code này không có lỗi gì cả. Muốn sửa được lỗi phải có file.

 

[tiendungnst]

Vậy thì thủ tục của bạn như thế này đi:

Private Sub cmdThem_Click()
    Dim c As Byte
    Dim ArrSheet(), ArrControls()
    ArrSheet = Sheets("THULY").Range("BB2:BH2")
    ArrControls = Array(cbxNguoinhanBC, txtNguoilapBC, txtNguoiduyetBC, _
                        cbxChucdanhduyetBC, txtNgaylapBC, txtSothangBC, _
                        txtThoigianBC)
    For c = 1 To 7
        If ArrControls(c - 1).Value > "" Then
            ArrSheet(c) = ArrControls(c - 1).Value
        End If
    Next
    Worksheets("THULY").Range("BB2:BH2") = ArrSheet
    Unload Me
End Sub

Em chạy đoạn Code trên thì có Debug, Em gửi File đính kèm, nhờ bác xem giúp!

 

[mhieuit]

Cac Anh Chi fix dum em code file dinh kem, code nay em lam chi ap dung dc 1 sheet, nhung khi enable (addin) qua file khac thi ko duoc, em muon khi addin qua sheet khac thi van run binh thuong.

Thank (Em xin loi unikey may co quan ko run duoc)

 

[huutinh85]

xin giải thích đoạn code

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]

e đang mày mò vba mà không hiểu ý nghia đoạn code này mong các bác giải thích giùm. cảm ơn các bác

Public Sub LOC_GV()
Dim sArr(), dArr(), TenGV As String, K As Long, I As Long, J As Long
With Sheets("DIEMDANH_GV")
sArr = .Range(.[B5], .[B65536].End(xlUp)).Resize(, 13).Value2
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 12)
With Sheets("LOC")
TenGV = UCase(.[C2])
For I = 1 To UBound(sArr, 1)
If UCase(sArr(I, 1)) = TenGV Then
K = K + 1: dArr(K, 1) = K
For J = 3 To 13
dArr(K, J - 1) = sArr(I, J)
Next J
End If
Next I
.[A4:L100].ClearContents
.[A4:L100].Borders.LineStyle = xlNone
If K Then
.[A4].Resize(K, 12) = dArr
.[A4].Resize(K, 12).Borders.LineStyle = xlContinuous
End If
End With
End Sub

 

[SA_DQ]

D1: Khai báo các biến cần thiết cho chương trình
D2: Tuyên cáo sẽ làm việc với trang tính có tên "DIEMANH_GV"
D3: Lấy vùng dữ liệu có ở cột [B:B] bắt đầu từ [B5] đem gám vô biến mảng đã khai báo
D4: Kết thúc tuyên cáo
D5: Khai báo 1 biến mảng gồm 12 cột & số dòng bằng với số dòng trong mảng đã nhận số liệu (sArr())
D6: Tuyên cáo làm việc với trang tính tên 'Loc'
D7: Lấy trị chuỗi ở ô [C2], cho nó trở thành kiểu việt hoa & đem gán vô biến TenGV
D8: Tạo vòng lặp duyệt theo toàn bộ các dòng trong biến mảng sArr() theo cột đầu của nó
(Vòng lặp này kết thúc tại D15)
D9: Điều kiện: Nếu kiểu viết hoa của trị đang duyệt trùng với trị chứa trong biến TenGV thì (thực hiện các lệnh sau)
D10: Tăng biến (đếm) K lên 1 đơn vị
Lấy trị K này gán vô biến mảng đã khai báp
(Xem tiếp bên dưới. . .)

Public Sub LOC_GV()
 Dim sArr(), dArr(), TenGV As String, K As Long, I As Long, J As Long
2 With Sheets("DIEMDANH_GV")
    sArr = .Range(.[B5], .[B65536].End(xlUp)).Resize(, 13).Value2
4 End With
 ReDim dArr(1 To UBound(sArr, 1), 1 To 12)
6 With Sheets("LOC")
    TenGV = UCase(.[C2])
8    For I = 1 To UBound(sArr, 1)
        If UCase(sArr(I, 1)) = TenGV Then
10            K = K + 1:         dArr(K, 1) = K
            For J = 3 To 13
12                dArr(K, J - 1) = sArr(I, J)
            Next J
14        End If
    Next I
16    .[A4:L100].ClearContents
    .[A4:L100].Borders.LineStyle = xlNone
18    If K Then
         .[A4].Resize(K, 12) = dArr
20         .[A4].Resize(K, 12).Borders.LineStyle = xlContinuous
    End If
22 End With
End Sub

D11: Tạo tiếp 1 vòng lặp theo J, biến thiên tử 3 cho tới 13
D12: Đem các trị tương ứng trong hàng gán vô mảng sau (tạm hiểu là mảng đích)
D13: Kết thúc vòng lặp
D15: Kết thúc điều kiện (Đ9)
D16: Xóa vùng dữ liệu từ [A4:L100]
D17: Format vùng này không kẻ dòng
D18: Điều kiện: Nếu K>0 thì (thực thi các dòng lệnh trước dòng 21)
D19: Lấy trị chứa trong mảng đích gán vô ô [A4]; mở rọng K dòng & 12 cột
D20: Vùng vừa được gán dữ liệu được format kẻ dòng nét mảnh
. . . .

Mong đã giúp bạn ít nhiều!

 

[hoaak2005]

Nhờ giải thích code

Có ai giải thích hộ mình đoạn code này:
Range("A8:H27").Value = Sheet2.Cells(9 + 20 * (ProductionDay - 1) + _
465 * (ProductionMonth - 1)).Resize(20, 8).Value
code này mình lấy trong đoạn copy dữ liệu từ sheet này sang sheet khác nhưng chưa hiểu chổ này. Thanks mọi người!

 

[leonguyenz]

Có ai giải thích hộ mình đoạn code này:
Range("A8:H27").Value = Sheet2.Cells(9 + 20 * (ProductionDay - 1) + _
465 * (ProductionMonth - 1)).Resize(20, 8).Value
code này mình lấy trong đoạn copy dữ liệu từ sheet này sang sheet khác nhưng chưa hiểu chổ này. Thanks mọi người!

Bạn gửi 1 đoạn thôi làm sao biết các lệnh, hàm, biến, ... trong đó là gì?

 

[hoaak2005]

Bạn gửi 1 đoạn thôi làm sao biết các lệnh, hàm, biến, ... trong đó là gì?

Ý mình muốn biết cấu trúc hàm này như thế nào ý mà! hic..tình hình là tại gửi file lên mà không được

 

[Hoàng Trọng Nghĩa]

Có ai giải thích hộ mình đoạn code này:
Range("A8:H27").Value = Sheet2.Cells(9 + 20 * (ProductionDay - 1) + _
465 * (ProductionMonth - 1)).Resize(20, 8).Value
code này mình lấy trong đoạn copy dữ liệu từ sheet này sang sheet khác nhưng chưa hiểu chổ này. Thanks mọi người!

Range("A8:H27").Value = Sheet2.Cells(9 + 20 * (ProductionDay - 1) + [COLOR=#ff0000][B]_
[/B][/COLOR]465 * (ProductionMonth - 1)).Resize(20, 8).Value

Dấu gạch nối màu đỏ (_) là cách mà chúng ta dùng để xuống hàng một câu lệnh trong code.

Nếu không xuống hàng thì nó sẽ như thế này:

Range("A8:H27").Value = Sheet2.Cells(9 + 20 * (ProductionDay - 1) + 465 * (ProductionMonth - 1)).Resize(20, 8).Value

Nếu như sau khi tính toán, kết quả của:

Sheet2.Cells(9 + 20 * (ProductionDay - 1) + 465 * (ProductionMonth - 1)).Resize(20, 8).Value

là một giá trị X nào đó, thì toàn bộ câu lệnh trên sẽ như sau:

Range("A8:H27").Value = [B][COLOR=#ff0000]X[/COLOR][/B]

Như vậy, toàn bộ vùng A8 đến H27 (A8:H27) đều nhận giá trị là X.

 

[VetMini]

Ở Sheet 2 có một bảng dữ liệu (có lẽ liên quan đến Production). Dùng con toán
9 + 20 * (ProductionDay - 1) + 465 * (ProductionMonth - 1)
sẽ tính ra được vị trí của một cột (có lẽ liên quan đến ProductionDay và ProductionMonth)
Tại dòng 1, cột vừa tính ra, lấy một mảng 20 dòng và 8 cột
Copy dữ liệu 160 ô này vào mảng A8:H27 của sheet hiện tại (có lẽ là sheet 1)

Bạn hỏi 1 câu mà muốn trả lời phải dùng tất cả 3 "có lẽ". Điều này chứng tỏ bạn cần học cách diễn đạt vấn đề hơn là học cách code.

 

[concogia]

Có ai giải thích hộ mình đoạn code này:
Range("A8:H27").Value = Sheet2.Cells(9 + 20 * (ProductionDay - 1) + _
465 * (ProductionMonth - 1)).Resize(20, 8).Value
code này mình lấy trong đoạn copy dữ liệu từ sheet này sang sheet khác nhưng chưa hiểu chổ này. Thanks mọi người!

Hình như đoạn code này để gán dữ liệu, trong đó:

Sheet2.Cells(9 + 20 * (ProductionDay - 1) + _
465 * (ProductionMonth - 1))

Xác định cell đầu tiên của vùng dữ liệu nguồn ở sheet 2

.Resize(20, 8)

Mở rộng vùng dữ liệu nguồn ra thành vùng có 20 hàng và 8 cột
Gán value của vùng dữ liệu nguồn này sang vùng nhận dữ liệu là vùng [A8:H27] ( chắc của sheet hiện hành)

 

[hoaak2005]

Thanks sự giúp đỡ của mọi người! Chả là mình đang thiết kế cái form nhập số liệu cho công việc, không rành VBA nhưng cũng mày mò đôi chút. Ban đầu cũng định hình được cái form như file đính kèm nhưng nó bị lỗi ở chỗ mỗi khi mình nhập dữ liệu vào sheet inputdata rồi enter nó lại nhảy sang sheet data, và hình như 2 sheet này chưa liên kết được với nhau. Mọi người chỉ ra cái lỗi giúp mình với!

 

[ChanhTQ@]

Bạn nên n6u rõ hơn đề cương của bạn là gì đi dùm 1 cái!

. . ., (2) nhưng nó bị lỗi ở chỗ mỗi khi mình nhập dữ liệu vào sheet inputdata rồi enter nó lại nhảy sang sheet data, (3) và hình như 2 sheet này chưa liên kết được với nhau.
(1) Mọi người chỉ ra cái lỗi giúp mình với!

(1) Nhìn thấy 1 rừng code luôn, nhưng không biết bắt đầu dò từ đâu để giúp bạn!

(2) Nên cụ thể là bạn muốn nhập vô vùng nào của trang này;
{ENTER} là {ENTER} ở ô cuối cùng nào khi nhập (sự kiện tại 1 ô nhất định) hay bấm vô nút chứa macro nào?

(3) Mình rờ vô các nút thì chúng im thinh thít;
Mà sao module 1 trống hơ, lại để các hàm của bạn ở module 2 làm chi vậy?

 

[hong loi]

Chào các thầy các anh, cho em hỏi em gặp vài cái code, ví dụ như mẩu dưới đây:

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 9 Then
   If ActiveSheet.ListBox1.ListCount = 0 Then
      Hide
      ActiveCell.Activate
   Else
      ActiveSheet.ListBox1.Activate
      ActiveSheet.ListBox1.ListIndex = 0
   End If
ElseIf KeyCode = 37 Then
   Hide
   ActiveCell.Offset(, -1).Activate
ElseIf KeyCode = 38 Then
   Hide
   ActiveCell.Offset(-1).Activate
ElseIf KeyCode = 39 Then
   Hide
   ActiveCell.Offset(, 1).Activate
ElseIf KeyCode = 40 Then
   If ActiveSheet.ListBox1.ListCount = 0 Then
      Hide
      ActiveCell.Offset(1).Activate
   Else
      ActiveSheet.ListBox1.Activate
      ActiveSheet.ListBox1.ListIndex = 0
   End If
ElseIf KeyCode = 46 Then
   Hide
   ActiveCell.ClearContents
   ActiveCell.Activate
End If
End Sub

Vậy những cái tên và con số: KeyCode = 9, KeyCode = 37, KeyCode = 38, KeyCode = 39, KeyCode = 40, KeyCode = 46 có nghĩa là gì ? có công dụng gì ?

Và ví dụ này:

Private Sub cboTenHang_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Select Case KeyCode
    Case 9, 13, 37 To 40
    Case Else

Case 9, 13, 37 To 40 : nghĩa là sao? công dụng như thế nào ?

 

[Hoàng Trọng Nghĩa]

Vậy những cái tên và con số: KeyCode = 9, KeyCode = 37, KeyCode = 38, KeyCode = 39, KeyCode = 40, KeyCode = 46 có nghĩa là gì ? có công dụng gì ?

Case 9, 13, 37 To 40 : nghĩa là sao? công dụng như thế nào ?

Với một Controls (TextBox, ComboBox v.v...) có các sự kiện là KeyUp, KeyDown, đối số của nó là một biến mang mã số của một key (phím). Các keycode đó là mã số của các phím Tab, Enter, và 4 phím mũi tên.

 

[vjaj2008]

bác nào cho em hoỉ có code nào thay thế cho function CONCATENATE không nhỉ?

 

[Hoàng Trọng Nghĩa]

bác nào cho em hoỉ có code nào thay thế cho function CONCATENATE không nhỉ?

Đây là một hàm nối chuỗi trong Excel:

=CONCATENATE(A1,B1)

Nó tương đương với:

=A1 & B1

Nhưng trong VBA, hàm này lại không được hỗ trợ bởi WorksheetFunction, vì thế ta chỉ việc nối chúng lại bằng & mà thôi.

ChuoiNoi = "Hoàng " & "Trọng " & "Nghĩa"

Nhưng nếu bạn muốn làm một hàm tự tạo thì như vầy:

Function vbaCONCATENATE(ParamArray VarArg()) As String
    vbaCONCATENATE = Join(VarArg, "")
End Function

Cấu trúc như hàm CONCATENATE.

 

[kdang]

Em tạo thủ tục định dạng có điều kiện (CF) bằng công thức cho workbook, nhưng khác với công thức khi được gán trong cell là
trong vba mặc định dấu "," còn trong VBA khi dùng CF nó không tự động chuyển đổi dấu nên đoạn code của em chỉ chạy được nếu máy đó chỉnh list seperator là ; mới chạy được. Các anh giúp em giải quyết vấn đề làm thế nào để code có thể hoạt động ở bất kỳ máy nào được không ạ.

Sub conditionalformatting()
'
' Macro2 Macro
'
        
    'set dieu kien cot L khong co CSDL
    Rows("2:1500").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$L2=""khong co CSDL"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = 0
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.399945066682943
        .PatternTintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
    'set dieu kien cot L can check du lieu
    Rows("2:1500").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=or($L2=""CHECK"";and($L2=""khong co CSDL"";iferror(search("" ? "";$J2);0)>0))"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
        'set dieu kien cot E (Kiem tra TK)
    Rows("2:1500").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND(len($e2)>0;or(len($e2)<>12;left($e2;4)<>""711A"";iferror(value(right($e2;len($e2)-5));0)=0))"
        
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
    'set dieu kien cot G (tien to)
    Range("G2:G1500").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND($G2<>""711A"";$G2<>"""")"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
    'set dieu kien cot F (so ky tu TK)
    Range("F2:F1500").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND($F2<>12;$F2<>0)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    

    
    'set dieu kien cot I
    Range("I2:I1500").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=OR(AND(LEN($I2)<>7;LEN($I2)<>0);AND(LEN($I2)=7;IFERROR(VALUE($I2);0)=0))"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("A2").Select
End Sub

 

[Hau151978]

Em tạo thủ tục định dạng có điều kiện (CF) bằng công thức cho workbook, nhưng khác với công thức khi được gán trong cell là
trong vba mặc định dấu "," còn trong VBA khi dùng CF nó không tự động chuyển đổi dấu nên đoạn code của em chỉ chạy được nếu máy đó chỉnh list seperator là ; mới chạy được. Các anh giúp em giải quyết vấn đề làm thế nào để code có thể hoạt động ở bất kỳ máy nào được không ạ.

Hàm Listseparator() sau đây sẽ trả kết quả là dấu phân cách. Bạn thay dấu ";" trong code thành hàm này.

Public Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Function listseparator() As String
Dim s As String
Dim n As Long
s = String(250, " ")
n = GetProfileString("Intl", "sList", "", s, 250)
listseparator = Left(s, 1)
End Function

 

[kdang]

Hàm Listseparator() sau đây sẽ trả kết quả là dấu phân cách. Bạn thay dấu ";" trong code thành hàm này.

Public Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Function listseparator() As String
Dim s As String
Dim n As Long
s = String(250, " ")
n = GetProfileString("Intl", "sList", "", s, 250)
listseparator = Left(s, 1)
End Function

em đã làm được rồi, cám ơn anh rất nhiều

 

[lhthai]

Chao cac anh GPE
Hiện tại em thấy code trên diễn đàn của anh quanghai như sau

[COLOR=#0000BB][FONT=monospace]Sub copydulieu[/FONT][/COLOR][COLOR=#007700][FONT=monospace]()
[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dim wb [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Workbook[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sh [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Worksheet[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]WBname [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]String
Dim cursh [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Worksheet[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]chk [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Boolean
Set cursh [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]ActiveSheet
WBname [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"KH.xls"
[/FONT][/COLOR][COLOR=#007700][FONT=monospace]For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Each wb In Workbooks
   [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]wb[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Name [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]WBname Then chk [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]True
Next
[/FONT][/COLOR][COLOR=#007700][FONT=monospace]If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]chk [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]False Then Workbooks[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Open [/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]ThisWorkbook[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Path [/FONT][/COLOR][COLOR=#007700][FONT=monospace]& [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"\" & WBname)
With Workbooks(WBname)
   For Each sh In .Worksheets
      sh.Range(sh.[C10], sh.[E65536].End(3)).Copy cursh.[B65536].End(3)(2)
      sh.Range(sh.[J10], sh.[L65536].End(3)).Copy cursh.[B65536].End(3)(2)
   Next
End With
cursh.Range("[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]B5[/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]", cursh.[B65536].End(3)).Offset(, -1) = [row(a:a)]
End Sub  [/FONT][/COLOR]

Hiện tại file này em muốn sữa chỉ copy 3 sheet trong KH thôi còn sheet 4 không copy
Chẳng hạn em muộn copy trên lấy file khác sửa tên thành kế hoạch và sua cột C10 & E thành cột khác
nó cũng chạy nhung copy từ C10 cho đến chữ tổng luôn chứ không giống code anh quanghai

 

[vacandem]

Kính gửi các anh chị. Em được giao nhiệm vụ quản lý đồ ăn nhẹ đặt tại các phòng trong một khách sạn. Những đồ này có thể bán, miễn phí (Comp) hoặc thất thoát do không tính tiền được với khách (Lost). Em đã tạo một file và để dữ liệu hàng ngày tại sheet “data”. Yêu cầu là phải kiểm soát được:
1.Lượng bán, doanh thu theo từng phòng, theo ngày, tháng cho từng loại mặt hàng ( đối với cả ba loại hình trên)
- với yêu cầu này em đã làm được trong sheet Daily và Monthly (cám ơn những đoạn code học được từ bác NDU và bác Pikachu) nhưng nếu muốn vừa có liệt kê chi tiết vừa có tổng tiền bên dưới của từng phòng , rồi từng ngày giống như dạng groupby trong access thì chưa làm được
2.Thống kê được lượng hàng đang có đặt trong phòng theo từng loại (sheet setup)
3.Kiểm soát ngày hết hạn của từng loại trong sheet ExDate (có nhiều hạn sử dụng khác nhau cho mỗi loại sản phẩm)
Hiện tại mỗi khi bù lại sản phẩm bán hoặc bị mất vào phòng em phải điền tay vào hai sheet trên. Do đó em làm sheet update để nhập cho nhanh nhưng vì mới tự mày mò VBA nên viết code dài dòng và lủng củng quá. Nhờ các anh chị chỉ dùm cách viết khác gọn hơn.
Nhân tiện xin cho em hỏi nếu từ những sheet đó có thể viết code để lọc ra một báo cáo tổng hợp về hạn sử dụng được không ạ ví dụ như:
Sản phẩm A có hạn X số lượng 100
Sản phẩm A có hạn Y số lượng 1100
Sản phẩm B có hạn Z số lượng 1600
Sản phẩm B có hạn X số lượng 1500
Và nếu có cách nào tổ chức dữ liệu tốt hơn xin các anh chị chỉ dù. Em xin cảm ơn

 

[phuoclocvl]

Các pro giải thích giúp em code

Dear Các Pro
em chưa hiểu đoạn code này, mong các pro giải thích giúp em, em mới tập tành học về code
Thanks

adors.Open cmdtxt, Db, 3, 3

 

[banhbao]

Option Explicit


Public Sub LOC_U18()
Dim sArr(), dArr(), I As Long, K As Long
With Sheets("DSCNV chuan ")
sArr = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 41).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 7)
For I = 1 To UBound(sArr, 1)
If sArr(I, 1) = "g" Then
If sArr(I, 41) < 18 Then
K = K + 1: dArr(K, 1) = K: dArr(K, 7) = sArr(I, 41)
dArr(K, 2) = sArr(I, 5): dArr(K, 3) = sArr(I, 7)
dArr(K, 4) = sArr(I, 9): dArr(K, 5) = sArr(I, 19)
dArr(K, 6) = "=Datedif(RC[-2],RC[-1],""Y"")"
End If
End If
Next I
Sheets("DS_U18").[A4:G4].Resize(K) = dArr
Sheets("DS_U18").[F4].Resize(K).Value = Sheets("DS_U18").[F4].Resize(K).Value
End Sub
em có đoẠN COBENAYF MONG CÁC BÁC GIẢI THÍCH GIÚP Ạ

 

[viehoai]

Code mở file

Kính nhờ các anh chị test xem giúp vì đâu Code file excel để mở file sao máy không báo lỗi nhưng cũng không được như ý.

 

[Quang_Hải]

Kính nhờ các anh chị test xem giúp vì đâu Code file excel để mở file sao máy không báo lỗi nhưng cũng không được như ý.

Chơi kỳ quá, không có code cũng không có file. Test bằng niềm tin nhé.

 

[viehoai]

Chơi kỳ quá, không có code cũng không có file. Test bằng niềm tin nhé.

Xin lỗi anh quên tải file.
Các anh chị vui lòng tải bài tại #160

 

[Ba Tê]

Xin lỗi anh quên tải file.
Các anh chị vui lòng tải bài tại #160

Bạn thử nhập thêm "cái đuôi" .doc vào ô D7 xem sao.

 

[viehoai]

Bạn thử nhập thêm "cái đuôi" .doc vào ô D7 xem sao.

Đúng vậy em thêm "đuôi" chạy được, nhưng ở file ứng dụng của em vẫn chưa tìm ra nguyên nhân mặc dù có "duôi" đầy đủ

 

[Ba Tê]

Đúng vậy em thêm "đuôi" chạy được, nhưng ở file ứng dụng của em vẫn chưa tìm ra nguyên nhân mặc dù có "duôi" đầy đủ

Vậy kiểm lại Path thôi, có cũng Folder không.

 

[viehoai]

Vậy kiểm lại Path thôi, có cũng Folder không.

Ồ, hóa ra nó không nhận trường hợp file có dấu tiếng Việt, không biết trường hợp xử lý như thế nào, các anh chị hướng dẫn em với nhé.

 

[Ba Tê]

Ồ, hóa ra nó không nhận trường hợp file có dấu tiếng Việt, không biết trường hợp xử lý như thế nào, các anh chị hướng dẫn em với nhé.

Chỉ còn cách sửa tên File không có dấu tiếng Việt, không có dấu cách cho chắc ăn.
Hình như VN chưa đặt hàng anh Bill chuyện này hay sao ấy (hic)

 

[dhn46]

Ồ, hóa ra nó không nhận trường hợp file có dấu tiếng Việt, không biết trường hợp xử lý như thế nào, các anh chị hướng dẫn em với nhé.

dhn46 nghĩ nếu anh cho tên file vào 1 ô Excel rồi lấy đó làm tham số mở ô thì chắc vẫn được chứ nhỉ?

 

[Quang_Hải]

Ồ, hóa ra nó không nhận trường hợp file có dấu tiếng Việt, không biết trường hợp xử lý như thế nào, các anh chị hướng dẫn em với nhé.

Nói code không nhận file đặt tên tiếng việt có dấu thì oan cho anh Bill quá.
Bản thân "Shell.Application" là nhất định phải mở được chứ. Đương nhiên là phải có extension đàng hoàng.

 

[Ba Tê]

Nói code không nhận file đặt tên tiếng việt có dấu thì oan cho anh Bill quá.
Bản thân "Shell.Application" là nhất định phải mở được chứ. Đương nhiên là phải có extension đàng hoàng.

Tôi chưa thử, nhưng tên file lưu trong Folder ghi bằng bảng mã khác (ví dụ: Unicode), tên file trong code "đòi" mở bằng bảng mã khác (Ví dụ TCVN3 - ABC hay Vni for Windows), vẫn có "extension đáng hoàng" nó vẫn nhận được sao ta?
Chắc phải thử lại xem sao.
-----------------
Đã thử rồi. Híc! Càng luxubu hơn là không dấu tiếng Việt, không dấu cách.

 

[ndu96081631]

Ồ, hóa ra nó không nhận trường hợp file có dấu tiếng Việt, không biết trường hợp xử lý như thế nào, các anh chị hướng dẫn em với nhé.

Vừa thí nghiệm xong: Tên file có dấu tiếng Việt + tên Folder có dấu tiếng Việt ---> Tất cả đều mở tuốt

 

[tanthanh94]

Em nhờ các anh giải thích 2 code sau

[COLOR=#007700][FONT=monospace]Private [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Sub CommandButton1_Click[/FONT][/COLOR][COLOR=#007700][FONT=monospace]()
[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dim sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace](), [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]dArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1 To 50000[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1 To 5[/FONT][/COLOR][COLOR=#007700][FONT=monospace]), [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Worksheet[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Long[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Long[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]K [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Long
[/FONT][/COLOR][COLOR=#007700][FONT=monospace]For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Each Ws In ThisWorkbook[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Worksheets
    [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Name [/FONT][/COLOR][COLOR=#007700][FONT=monospace]<> [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"KH" [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Then
        sArr [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Range[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J4[/FONT][/COLOR][COLOR=#007700][FONT=monospace]], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J4[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]End[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]xlToRight[/FONT][/COLOR][COLOR=#007700][FONT=monospace])).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Resize[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]5[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Value
        [/FONT][/COLOR][COLOR=#007700][FONT=monospace]For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1 To UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]2[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
            [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]K [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]K [/FONT][/COLOR][COLOR=#007700][FONT=monospace]+ [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1
            [/FONT][/COLOR][COLOR=#007700][FONT=monospace]For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1 To 5
                dArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]K[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
            [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Next I
        Next J
    End [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If
[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Next Ws
Sheets[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"KH"[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]A14[/FONT][/COLOR][COLOR=#007700][FONT=monospace]:[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]E50000[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]ClearContents
Sheets[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"KH"[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]A14[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Resize[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]K[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]5[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]dArr
End Sub  [/FONT][/COLOR]

Public

[COLOR=#0000BB][FONT=monospace]Sub GPE[/FONT][/COLOR][COLOR=#007700][FONT=monospace]()
[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dim sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace](), [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]dArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace](), [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Long[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Long[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]DK [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]String[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dic [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Object[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Tem [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]String[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]CoL [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Long[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Worksheet
Set Dic [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]CreateObject[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"Scripting.Dictionary"[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Range[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]A14[/FONT][/COLOR][COLOR=#007700][FONT=monospace]], [[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]A14[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]End[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]xlDown[/FONT][/COLOR][COLOR=#007700][FONT=monospace])).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Value
DK [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]G12[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Value
ReDim dArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1 To UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]), [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1 To 1[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1 To UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
    [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Tem [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
    If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Not Dic[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]exists[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Tem[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Then Dic[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Add Tem[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I
Next I
[/FONT][/COLOR][COLOR=#007700][FONT=monospace]For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Each Ws In Worksheets
    [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Name [/FONT][/COLOR][COLOR=#007700][FONT=monospace]<> [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"KH" [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Then
        CoL [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J4[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]End[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]xlToRight[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Column [/FONT][/COLOR][COLOR=#007700][FONT=monospace]- [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1
        sArr [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Range[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]B4[/FONT][/COLOR][COLOR=#007700][FONT=monospace]], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]B65536[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]End[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]xlUp[/FONT][/COLOR][COLOR=#007700][FONT=monospace])).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Resize[/FONT][/COLOR][COLOR=#007700][FONT=monospace](, [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]CoL[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Value
        [/FONT][/COLOR][COLOR=#007700][FONT=monospace]For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]7 To UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
            If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]DK Then
                [/FONT][/COLOR][COLOR=#007700][FONT=monospace]For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]9 To UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]2[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
                    [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Tem [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
                    If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dic[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]exists[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Tem[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Then dArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dic[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Item[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Tem[/FONT][/COLOR][COLOR=#007700][FONT=monospace]), [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
                [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Next J
            End [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If
        [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Next I
    End [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If
[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Next Ws
[/FONT][/COLOR][COLOR=#007700][FONT=monospace][[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]G14[/FONT][/COLOR][COLOR=#007700][FONT=monospace]:[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]G50000[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]ClearContents
[/FONT][/COLOR][COLOR=#007700][FONT=monospace][[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]G14[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Resize[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]dArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace])) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]dArr
Set Dic [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Nothing
End Sub [/FONT][/COLOR]

http://www.giaiphapexcel.com/forum/...-hàm-INDEX-MATCH-lấy-dữ-liệu-tất-cả-các-sheet

 

[hvn8006]

Các bác cho hỏi khi mở cửa sổ VBA hiện lỗi này là thế nào ạ. Phương án giải quyết thế nào ạ.

 

[Hau151978]

Các bác cho hỏi khi mở cửa sổ VBA hiện lỗi này là thế nào ạ. Phương án giải quyết thế nào ạ.

Thử luyện mắt xem sao, bạn thêm ptrsafe sau declare xem còn lỗi không?

 

[hvn8006]

Nhờ các tiền bối giải thích cho em code của hàm này với ạ. Em xin chân thành cảm ơn!

Function VT_KieuThep(ByVal FindKT As String) As Long
Const Start_Index_Data = 5
Dim Rng As Range
If Trim(FindKT) <> "" Then
With Sheet1.Range("C" & Start_Index_Data & ":C" & Sheet1.UsedRange.Rows.Count)
Set Rng = .Find(what:=FindKT, _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
VT_KieuThep = Rng.Row
Else
VT_KieuThep = 0
End If
End With
End If
End Function

 

[Hoàng Trọng Nghĩa]

Nhờ các tiền bối giải thích cho em code của hàm này với ạ. Em xin chân thành cảm ơn!

Function VT_KieuThep(ByVal FindKT As String) As Long
Const Start_Index_Data = 5
Dim Rng As Range
If Trim(FindKT)

 

[Quang_Hải]

Nhờ các tiền bối giải thích cho em code của hàm này với ạ. Em xin chân thành cảm ơn!

Function VT_KieuThep(ByVal FindKT As String) As Long
Const Start_Index_Data = 5
Dim Rng As Range
If Trim(FindKT) <> "" Then
With Sheet1.Range("C" & Start_Index_Data & ":C" & Sheet1.UsedRange.Rows.Count)
Set Rng = .Find(what:=FindKT, _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
VT_KieuThep = Rng.Row
Else
VT_KieuThep = 0
End If
End With
End If
End Function

Nghĩ mãi mà không hiểu ai lại viết chi cái hàm này, trong khi Match có sẵn của excel thì không xài.

 

[Hoàng Trọng Nghĩa]

Nghĩ mãi mà không hiểu ai lại viết chi cái hàm này, trong khi Match có sẵn của excel thì không xài.

Tại người ta thích viết UDF cho nó hoành tá tràng đó mà!- */

 

[hvn8006]

Đây là một hàm dựa vào một chuỗi để tìm ra số hàng mà chuỗi đó tồn tại trong một vùng ở cột C của sheet1.

Nếu là tôi, tôi sẽ viết hàm này rộng hơn.

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

Tôi viết cho bạn đây:

Function VT_KieuThep(ByVal FindKT, ByVal FindRange As Range) As Long
    On Error Resume Next
    VT_KieuThep = FindRange.Find(what:=FindKT, LookIn:=xlValues, Lookat:=xlWhole).Row
End Function

Công thức:

=VT_KieuThep(F1,$C$1:$C$34)

hoặc:

=VT_KieuThep("Nghĩa",$C$1:$C$34)

Vấn đề là khi đưa hàm của anh HTN vào thủ tục sau thì nó bị lỗi ạ, chắc là do người viết code quá cầu kỳ đọc khó hiều quá. Nhờ các anh xử lý giúp ạ.

Private Sub Worksheet_Change(ByVal Target As Range)
Const start_index = 7
Dim Row_Index As Long
Dim Row_Data As Long
Dim Row_Height As Long
Dim j As Long
If InStr(Target.Address, "$C$") > 0 Then 'Vi tri cua Cell tai cot C
If Target.Count <> 1 Then Exit Sub 'Neu chon lon hon thi bo qua
Row_Data = VT_KieuThep(Range("C" & Target.Row))
If Range("C" & Target.Row) <> "" And Row_Data > 0 Then
Row_Index = Target.Row
Row_Height = Sheet1.Range("D" & Row_Data).RowHeight
Sheet2.Range("D" & Row_Index).RowHeight = Row_Height
Sheet1.Activate
Sheet1.Range("D" & Row_Data & ":R" & Row_Data).Select
Application.CutCopyMode = False
Selection.Copy
Sheet2.Select
Sheet2.Range("D" & Row_Index).Select
ActiveSheet.Paste
Sheet2.Range("C" & Row_Index + 1).Select
Else
End If
End If
End Sub

 

[VetMini]

Vấn đề là khi đưa hàm của anh HTN vào thủ tục sau thì nó bị lỗi ạ, chắc là do người viết code quá cầu kỳ đọc khó hiều quá. Nhờ các anh xử lý giúp ạ.

Row_Data = VT_KieuThep(Range("C" & Target.Row))

cầu kỳ hay không là ý cá nhân. Chỉ là hàm của người ta cần 2 tham số, bạn chỉ cung cấp 1 thì nó lỗi là lẽ đương nhiên. Cái đơn giản này mà bạn không biết thì kêu giải thích code làm chi cho mất công.

 

[hvn8006]

cầu kỳ hay không là ý cá nhân. Chỉ là hàm của người ta cần 2 tham số, bạn chỉ cung cấp 1 thì nó lỗi là lẽ đương nhiên. Cái đơn giản này mà bạn không biết thì kêu giải thích code làm chi cho mất công.

Rất cảm ơn anh VetMini đã giải đáp, em cũng có suy nghĩ là sai hàm khi áp dụng, nhưng mới học được chút ít nền chưa biết sửa thế nào cho phù hợp thôi ạ.

 

[quykh]

Theo chỉ dẫn của Thầy NDu, Em xin gửi qua Topic này. Em có file giả định mong mọi người viết code cho phiếu xuất chép qua "Chi tiết xuất hàng". Tự động đánh số thứ tự và báo lỗi khi các cell G3,G4,G5,G6 không có dữ liệu.

 

[Quang_Hải]

Theo chỉ dẫn của Thầy NDu, Em xin gửi qua Topic này. Em có file giả định mong mọi người viết code cho phiếu xuất chép qua "Chi tiết xuất hàng". Tự động đánh số thứ tự và báo lỗi khi các cell G3,G4,G5,G6 không có dữ liệu.

Sub PhieuXuat()
Dim Rngs(), i As Long, TieuDe(), kt
With Sheet2
    If .[F8] = "" Then Exit Sub
    kt = Application.CountA(.[G3], .[G4], .[G5], .[G6])
    If kt < 4 Then
      MsgBox "Thieu du lieu"
      Exit Sub
    End If
    Rngs = .Range(.[F8], .[I65536].End(3)).Value
    TieuDe = Array(.[G3].Value, .[G4].Value, .[G5].Value, .[G6].Value)
    .Range("G3:G6, F8:I30").ClearContents
    .[G3].Select
End With
With Sheet1.Range("D65536").End(3)
   .Offset(1, 5).Resize(UBound(Rngs), 4).Value = Rngs
   .Offset(1, 1).Resize(UBound(Rngs), 4).Value = TieuDe
   .Parent.Range("D4", .Parent.[E65536].End(3).Offset(, -1)) = [row(a:a)]
End With
ActiveWorkbook.Save
End Sub

 

[Em khong biet]

Chào các bác trong GPE!
Em thấy code trên diễn đàn như sau (bài: http://www.giaiphapexcel.com/forum/showthread.php?94949-Giúp-đỡ-Lấy-ra-kết-quả-ra-cột-mới):

Sub fill()
With Application
For Each cell In ActiveSheet.UsedRange.Columns(1).Cells
If cell <> "" And .CountIf(Rows(1), cell) Then
Cells(cell.End(xlUp).Row, .Match(cell, Rows(1), 0)).Formula = "=" &cell.Offset(, 2).Address
End If
Next
End With 
End Sub

Em muốn copy giá trị Vật liệu, Nhân công, Máy thi công sang cột I, J, L (như file đính kèm) thì sửa code trên như thế nào ạ, các bác giúp em với.
Chân thành cảm ơn các bác!
Chúc diễn đàn ngày càng phát triển!

 

[Em khong biet]

Code này hay quá, các bác làm ơn giúp em với ạ!

 

[0972767890]

các anh cho em hỏi về private function marc1(bf0,n,radphi0,radphi)

em có đoạn code này từ trang nước ngoài.em muốn chuyển nó sang một ngôn ngữ khác.
các anh có thể giải thích cho em đoạn M = Marc1(bf0, n, RadPHI0, RadPHI) ma em gạch chân bên dưới ý nghĩa nó như thế nào được không ạ.như ở đây M sẽ lấy giá trị gì từ marc1.
e đang làm trong basic for androi không có kiểu như thế,có thể thay đổi bằng phương pháp tính toán nào khác đc k ạ
em xin cám ơn các anh


Function WGS84LL2North(PHI As Double, LAM As Double)
Dim a, b, e0, f0, n0, PHI0 As Double
a = 6378137
b = 6356752.3141
e0 = 500000
f0 = 0.9996
PHI0 = 0
n0 = 0


'Calculate LAM0 of the UTM zone which the user input Longitude is in
Dim PreZNum As Double
Dim ZNum As Integer
Dim LAM0 As Double
PreZNum = (180 + LAM) / 6 + 1
ZNum = Int(PreZNum)
LAM0 = -(183 - 6 * ZNum)


'Convert angle measures to radians
PI = 3.14159265358979
RadPHI = PHI * (PI / 180)
RadLAM = LAM * (PI / 180)
RadPHI0 = PHI0 * (PI / 180)
RadLAM0 = LAM0 * (PI / 180)

af0 = a * f0
bf0 = b * f0
e2 = ((af0 ^ 2) - (bf0 ^ 2)) / (af0 ^ 2)
n = (af0 - bf0) / (af0 + bf0)
nu = af0 / (Sqr(1 - (e2 * ((Sin(RadPHI)) ^ 2))))
rho = (nu * (1 - e2)) / (1 - (e2 * (Sin(RadPHI)) ^ 2))
eta2 = (nu / rho) - 1
p = RadLAM - RadLAM0

M = Marc1(bf0, n, RadPHI0, RadPHI)

I = M + n0
II = (nu / 2) * (Sin(RadPHI)) * (Cos(RadPHI))
III = ((nu / 24) * (Sin(RadPHI)) * ((Cos(RadPHI)) ^ 3)) * (5 - ((Tan(RadPHI)) ^ 2) + (9 * eta2))
IIIA = ((nu / 720) * (Sin(RadPHI)) * ((Cos(RadPHI)) ^ 5)) * (61 - (58 * ((Tan(RadPHI)) ^ 2)) + ((Tan(RadPHI)) ^ 4))

WGS84LL2North = I + ((p ^ 2) * II) + ((p ^ 4) * III) + ((p ^ 6) * IIIA)

End Function


Private Function Marc1(bf0, n, PHI0, PHI)
Marc1 = bf0 * (((1 + n + ((5 / 4) * (n ^ 2)) + ((5 / 4) * (n ^ 3))) * (PHI - PHI0)) _
- (((3 * n) + (3 * (n ^ 2)) + ((21 / 8) * (n ^ 3))) * (Sin(PHI - PHI0)) * (Cos(PHI + PHI0))) _
+ ((((15 / 8) * (n ^ 2)) + ((15 / 8) * (n ^ 3))) * (Sin(2 * (PHI - PHI0))) * (Cos(2 * (PHI + PHI0)))) _
- (((35 / 24) * (n ^ 3)) * (Sin(3 * (PHI - PHI0))) * (Cos(3 * (PHI + PHI0)))))

End Function

 

[flycat]

Code 1

Private Sub Command1_Click()    
    Dim xlApp As [COLOR=#ff0000]Excel.Application[/COLOR]
    Dim xlWB As [COLOR=#ff0000]Excel.Workbook[/COLOR]
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Open("d:\tor\1.xls")
End Sub

Code 2

Private Sub Command1_Click()
    Dim xlApp As [COLOR=#ff0000]Object[/COLOR]
    Dim xlWB As [COLOR=#ff0000]Object[/COLOR]
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Open("d:\tor\1.xls")
End Sub

Code 2 chạy được, code 1 báo lỗi "user defined type not defined"
Xin hỏi vì sao báo lỗi?

Cảm ơn nhiều.

 

[Thuyanhanoi]

Không chạy macro ở sheet mong muốn

- Chào các anh chị và các bạn!.
- Mình có viết một macro để sao chép một vùng dữ liệu (Code sử dụng mảng) như sau:

Public Sub Tap_Chep()    
    Dim I As Long, J As Long, sArr(), dArr(), K As Long
    With Sheets("Tong_hop")
        sArr = Range("A12:AL52").Value
    End With
    ReDim dArr(1 To UBound(sArr, 1), 1 To 38)
    For I = 1 To UBound(sArr, 1)
        K = K + 1
        dArr(K, 1) = sArr(I, 1)
        For J = 2 To 38
            dArr(K, J) = sArr(I, J)
        Next J
    Next I
    With Sheets("A_1")
        .[A12].Resize(K, 38).Value = dArr
        .[A12].Resize(K, 36).Borders.LineStyle = xlContinuous
        .[A12].Resize(K, 36).Borders(xlInsideHorizontal).Weight = xlHairline
    End With
End Sub

- Các bạn cho mình hỏi vì sao code của mình chỉ cho kết quả khi mình ở sheet Tong_hop để gọi Sub. Còn khi ở sheet A_1 để gọi Sub thì code lại không cho kết quả. Mà mình muốn code cho kết quả khi ở sheet A_1.
Xin cảm ơn !.

 

[Hau151978]

- Chào các anh chị và các bạn!.
- Mình có viết một macro để sao chép một vùng dữ liệu (Code sử dụng mảng) như sau:

Public Sub Tap_Chep()    
    Dim I As Long, J As Long, sArr(), dArr(), K As Long
    With Sheets("Tong_hop")
        sArr = Range("A12:AL52").Value
    End With
    ReDim dArr(1 To UBound(sArr, 1), 1 To 38)
    For I = 1 To UBound(sArr, 1)
        K = K + 1
        dArr(K, 1) = sArr(I, 1)
        For J = 2 To 38
            dArr(K, J) = sArr(I, J)
        Next J
    Next I
    With Sheets("A_1")
        .[A12].Resize(K, 38).Value = dArr
        .[A12].Resize(K, 36).Borders.LineStyle = xlContinuous
        .[A12].Resize(K, 36).Borders(xlInsideHorizontal).Weight = xlHairline
    End With
End Sub

- Các bạn cho mình hỏi vì sao code của mình chỉ cho kết quả khi mình ở sheet Tong_hop để gọi Sub. Còn khi ở sheet A_1 để gọi Sub thì code lại không cho kết quả. Mà mình muốn code cho kết quả khi ở sheet A_1.
Xin cảm ơn !.

Bạn sửa lệnh
With Sheets("Tong_hop")
sArr = Range("A12:AL52").Value
End With
thành
sArr = Sheets("Tong_hop").Range("A12:AL52").Value

 

[Thuyanhanoi]

Bạn sửa lệnh
With Sheets("Tong_hop")
sArr = Range("A12:AL52").Value
End With
thành
sArr = Sheets("Tong_hop").Range("A12:AL52").Value

- Cảm ơn bạn nhé!. Mình sửa theo hướng dẫn của bạn code đã chạy OK!.
- Bạn ơi cho mình hỏi một chút!.
With Sheets("Tong_hop")
sArr = Range("A12:AL52").Value
End With
và
sArr = Sheets("Tong_hop").Range("A12:AL52").Value
Tại sao lại có sự khác nhau như vậy, theo mình hiều thì đều là gán vùng dữ liệu vào mảng ở sheet Tong_hop; còn khi đưa xuống sheet cần gán dữ liệu thì mình đã đặt trong cum này mà!.

With Sheets("A_1")        
        .[A12].Resize(K, 38).Value = dArr
         [A12:AL52].Resize(K) = dArr
        .[A12].Resize(K, 36).Borders.LineStyle = xlContinuous
        .[A12].Resize(K, 36).Borders(xlInsideHorizontal).Weight = xlHairline
    End With

 

[comet_1701]

With Sheets("A_1")        .[A12].Resize(K, 38).Value = dArr
        '[A12:AL52].Resize(K) = dArr
        .[A12].Resize(K, 36).Borders.LineStyle = xlContinuous
        .[A12].Resize(K, 36).Borders(xlInsideHorizontal).Weight = xlHairline
    End With

- Cảm ơn bạn nhé!. Mình sửa theo hướng dẫn của bạn code đã chạy OK!.
- Bạn ơi cho mình hỏi một chút!.
With Sheets("Tong_hop")
sArr = Range("A12:AL52").Value
End With
và
sArr = Sheets("Tong_hop").Range("A12:AL52").Value
Tại sao lại có sự khác nhau như vậy, theo mình hiều thì đều là gán vùng dữ liệu vào mảng ở sheet Tong_hop; còn khi đưa xuống sheet cần gán dữ liệu thì mình đã đặt trong cum này mà!.

With Sheets("Tong_hop")
sArr = .Range("A12:AL52").Value
End With
bạn sửa thế xem sao

 

[Ba Tê]

- Chào các anh chị và các bạn!.
- Mình có viết một macro để sao chép một vùng dữ liệu (Code sử dụng mảng) như sau:

Public Sub Tap_Chep()    
    Dim I As Long, J As Long, sArr(), dArr(), K As Long
    With Sheets("Tong_hop")
        sArr = Range("A12:AL52").Value
    End With
    ReDim dArr(1 To UBound(sArr, 1), 1 To 38)
    For I = 1 To UBound(sArr, 1)
        K = K + 1
        dArr(K, 1) = sArr(I, 1)
        For J = 2 To 38
            dArr(K, J) = sArr(I, J)
        Next J
    Next I
    With Sheets("A_1")
        .[A12].Resize(K, 38).Value = dArr
        .[A12].Resize(K, 36).Borders.LineStyle = xlContinuous
        .[A12].Resize(K, 36).Borders(xlInsideHorizontal).Weight = xlHairline
    End With
End Sub

- Các bạn cho mình hỏi vì sao code của mình chỉ cho kết quả khi mình ở sheet Tong_hop để gọi Sub. Còn khi ở sheet A_1 để gọi Sub thì code lại không cho kết quả. Mà mình muốn code cho kết quả khi ở sheet A_1.
Xin cảm ơn !.

Thiếu chỉ một dấu chấm.
With Sheets("Tong_hop")
sArr = .Range("A12:AL52").Value
End With

 

[Thuyanhanoi]

Thiếu chỉ một dấu chấm.
With Sheets("Tong_hop")
sArr = .Range("A12:AL52").Value
End With

- Em cảm ơn Thầy Ba Tê ạ!.
- Vậy mà em nhìn cả buổi mà không Thấy chỗ thiếu híc híc!.
- Vậy là:

[COLOR=#000000][I]With Sheets("Tong_hop")[/I][/COLOR]
[COLOR=#000000][I]sArr = .Range("A12:AL52").Value[/I][/COLOR]
[COLOR=#000000][I]End With[/I][/COLOR]
[COLOR=#000000][I]và [/I][/COLOR]
[COLOR=#000000][I]sArr = Sheets("Tong_hop").Range("A12:AL52").Value
[/I][/COLOR]

Mới không có sự khác nhau!.

 

[loinguyen212]

Sử dụng with...end with.
Chào mọi người, em muốn hỏi: Có cách nào thực hiện được việc khi đang ở sheet2 mà sử dụng With ... End with để chọn toàn bộ cells của sheet1 không? Em cảm ơn.

 

[Let'GâuGâu]

Sử dụng with...end with.
Chào mọi người, em muốn hỏi: Có cách nào thực hiện được việc khi đang ở sheet2 mà sử dụng With ... End withđể chọn toàn bộ cells của sheet1 không? Em cảm ơn.

bạn ở sheet2 thì làm sao chọn ở sheet1 được
nhưng bạn có thể làm bất cứ thao tác nào, như lấy dữ liệu, filter, hay làm cái gì đó
cái này không được

With Sheet1
    .Cells.Select
    End With

nhưng cái này thì được

With Sheet1
    .Cells.clear
    End With

 

[loinguyen212]

Cảm ơn bác LetGauGau. Mặc dù chưa được đúng theo ý hiểu của em nhưng sáng nay đọc bài của bác em mò mẫm tiếp thì lại có một kết quả khá thỏa mãn. Giải quyết được nhiều vấn đề vướng mắc lâu nay. Cho em hỏi thêm khi sử dụng with ..end with này có giúp code nhanh hơn không? (hiểu ngây ngô thì kiểu như đang ở sheet2 đỡ phải select về sheet1, thực hiện xong câu lệnh nào đó rồi mới quay lại sheet2, còn nếu đưa vào with thì không cần như thế)

 

[hikaru0110]

Xin hỏi về 2 dòng code vba này ạ

Các tiền bối cho mình hỏi 2 dòng lệnh này có ý nghĩa gì với ạ:

  Range("SPValues").Columns.Hidden = False
        Range(Range("SFStart").Offset(1, 0), Range("SFStart").Offset(1, 6).End(xlDown)).ClearContents

 

[SA_DQ]

Các tiền bối cho mình hỏi 2 dòng lệnh này có ý nghĩa gì với ạ:

  Range("SPValues").Columns.Hidden = False
        Range(Range("SFStart").Offset(1, 0), Range("SFStart").Offset(1, 6).End(xlDown)).ClearContents

Bạn không được fép đưa bài cùng nội dung lên 2 nơi (http://www.giaiphapexcel.com/forum/showthread.php?85576-Chuyên-mục-xử-lý-gỡ-rối-code-VBA/page44)

 

[Let'GâuGâu]

Cảm ơn bác LetGauGau. Mặc dù chưa được đúng theo ý hiểu của em nhưng sáng nay đọc bài của bác em mò mẫm tiếp thì lại có một kết quả khá thỏa mãn. Giải quyết được nhiều vấn đề vướng mắc lâu nay. Cho em hỏi thêm khi sử dụng with ..end with này có giúp code nhanh hơn không? (hiểu ngây ngô thì kiểu như đang ở sheet2 đỡ phải select về sheet1, thực hiện xong câu lệnh nào đó rồi mới quay lại sheet2, còn nếu đưa vào with thì không cần như thế)

tôi nghĩ nếu bạn bỏ đi mấy cái select thì tốc độ nó sẻ nhanh hơn
ví dụ

for i=1 to 1000
   [A1].offset(i).select
   selection.copy
   [B1].offset(i).paste
next

so với

for i=1 to 1000
   [B1].offset(i).value=[A1].offset(i).value
next

bạn cho code chạy thì bạn sẻ cảm nhận được cái select

 

[loinguyen212]

Em có đoạn code mọi người xem có rút ngắn gọn hơn được không ạ?

Dim oSelFormulas As Range
    Sheet5.Select
        Cells.Locked = False
        Set oSelFormulas = Cells.SpecialCells(xlCellTypeFormulas)
        oSelFormulas.Locked = True
        Sheet5.Protect "123123", True, True, True, True
    Sheet10.Select
        Cells.Locked = False
        Set oSelFormulas = Cells.SpecialCells(xlCellTypeFormulas)
        oSelFormulas.Locked = True
        Sheet10.Protect "123123", True, True, True, True
    Sheet12.Select
        Cells.Locked = False
        Set oSelFormulas = Cells.SpecialCells(xlCellTypeFormulas)
        oSelFormulas.Locked = True
        Sheet12.Protect "123123", True, True, True, True
    Sheet13.Select
        Cells.Locked = False
        Set oSelFormulas = Cells.SpecialCells(xlCellTypeFormulas)
        oSelFormulas.Locked = True
        Sheet13.Protect "123123", True, True, True, True
    Sheet6.Select
        Cells.Locked = False
        Set oSelFormulas = Cells.SpecialCells(xlCellTypeFormulas)
        oSelFormulas.Locked = True
        Sheet6.Protect "123123", True, True, True, True