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

Liên hệ QC

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

  • maytinhvp01

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

    [/INFO1]
     
    Chỉnh sửa lần cuối bởi điều hành viên:
    Cho em hỏi
    Rws = [B9].CurrentRegion.Rows.Count - 8
    Cells(Rws + 9, 1).Resize(65000, 45).Delete
    Em dùng để delete các ô kẻ định dạng... mà không có dữ liệu nhưng càng chạy lệnh file càng phình to hơn. Kiểm tra dòng cuối cùng của sheet thì ban đầu giả sử chưa chạy lệnh là A, sau khi chạy lệnh dòng cuối cùng là A+65000. Tại sao lại như vậy nhỉ. Có cách nào để xóa toàn bộ ô cột định dạng sau dòng dữ liệu cuối cùng không ạ?
    bạn thử dùng lệnh sau, không biết được không
    range(Cells(Rws + 9, 1),Cells(65536, 45).clear
     
    Upvote 0
    Cho e hỏi về thủ tục sau:

    i = Application.GetOpenFilename( _ filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
    (Tên file e chọn sẽ là: GPE.xlsx)

    E thay i = GPE.xlsx để không phải gọi hộp thoại GetOpenFileName, nhưng không hoạt động được. Vậy có cách nào không càn dùng GetopenfileName khi mà ta đã biết sẵn tên của WorkBook ko ạ ?
     
    Upvote 0
    Cho e hỏi về thủ tục sau:

    i = Application.GetOpenFilename( _ filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
    (Tên file e chọn sẽ là: GPE.xlsx)

    E thay i = GPE.xlsx để không phải gọi hộp thoại GetOpenFileName, nhưng không hoạt động được. Vậy có cách nào không càn dùng GetopenfileName khi mà ta đã biết sẵn tên của WorkBook ko ạ ?
    (1) Thử lần lượt 2 sub sau:
    Mã:
    Sub Test1()
    Dim pth
    pth = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*),*.xlsx*", [COLOR=#ff0000]MultiSelect:=True[/COLOR]) 'MultiSelect=true thì kết quả (nếu chọn file) trả về mảng 1 chiều, phần tử đầu tiên là có chỉ số là 1.
    If TypeName(pth) = "Variant()" Then MsgBox pth(1)
    End Sub
    Mã:
    Sub Test2()
    Dim pth
    pth = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*),*.xlsx*", [COLOR=#ff0000]MultiSelect:=False[/COLOR]) 'MultiSelect=false thì kết quả (nếu chọn file) trả về 1 chuỗi là đường dẫn (đầy đủ) của file vừa chọn
    If pth <> False Then MsgBox pth
    End Sub
    (2) So sánh kết quả vừa nhận được từ 2 sub trên với điều cần làm với tên file đã có GPE.xlsx. (?)
    Tức là nếu không cần GetOpenFilename thì i = [đường dẫn đầy đủ của file] (ví dụ: i="C:\Folder123\GPE.xlsx")
     
    Upvote 0
    (1) Thử lần lượt 2 sub sau:
    Mã:
    Sub Test1()
    Dim pth
    pth = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*),*.xlsx*", [COLOR=#ff0000]MultiSelect:=True[/COLOR]) 'MultiSelect=true thì kết quả (nếu chọn file) trả về mảng 1 chiều, phần tử đầu tiên là có chỉ số là 1.
    If TypeName(pth) = "Variant()" Then MsgBox pth(1)
    End Sub
    Mã:
    Sub Test2()
    Dim pth
    pth = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*),*.xlsx*", [COLOR=#ff0000]MultiSelect:=False[/COLOR]) 'MultiSelect=false thì kết quả (nếu chọn file) trả về 1 chuỗi là đường dẫn (đầy đủ) của file vừa chọn
    If pth <> False Then MsgBox pth
    End Sub
    (2) So sánh kết quả vừa nhận được từ 2 sub trên với điều cần làm với tên file đã có GPE.xlsx. (?)
    Tức là nếu không cần GetOpenFilename thì i = [đường dẫn đầy đủ của file] (ví dụ: i="C:\Folder123\GPE.xlsx")

    E xem hộp thoại Local cũng bít được nó sẽ là đường dẫn đầy đủ của file, nhưng chưa hiểu rõ vì sao. Cảm ơn a đã chia sẻ !
     
    Upvote 0
    Cho e hỏi khi khai báo mảng, bắt buộc mình phải ở Activesheet phải ko ạ.

    E đang ở Sheet1 khai bao:
    Dim Arr()
    Arr = Sheets("Sheet2").Range(....).value --> là bị báo lỗi ngay
     
    Upvote 0
    Cho e hỏi khi khai báo mảng, bắt buộc mình phải ở Activesheet phải ko ạ.

    E đang ở Sheet1 khai bao:
    Dim Arr()
    Arr = Sheets("Sheet2").Range(....).value --> là bị báo lỗi ngay

    (1) Chép đủ dòng code, chứ (....) là cái gì?

    (2) Lỗi báo như nào?

    (3) Kiểm tra xem có cái sheet nào có .name="Sheet2" không?
     
    Upvote 0
    (1) Chép đủ dòng code, chứ (....) là cái gì?

    (2) Lỗi báo như nào?

    (3) Kiểm tra xem có cái sheet nào có .name="Sheet2" không?


    Cám ơn a. E tìm được nguyên nhân rùi
    - Trước khai báo là: Darr = Range("L5", Range("L5").End(xlDown)).Resize(, 3).Value
    - E chuyển sheet khác mà chỉ khai báo: Darr = Sheets("BAN").Range("L5", Range("L5").End(xlDown)).Resize(, 3).Value

    Cái phần bôi đậm, e thiếu Sheets("BAN") ở đằng trước . Bị báo lỗi Application.defined or object-defined error !

    Xin lỗi a, lỗi này không đáng để hỏi, e chưa tìm hiểu kĩ đã vội hỏi. a và mọi người thông cảm ạ !
     
    Upvote 0
    - E có file về tạo ListBox và có thắc mắc sau:
    - Khi Click vào Save trong Form thì bị lỗi ở cột thứ 11, mày mò mãi vẫn chưa thể hiểu đc nguyên nhân vì thấy nó đúng mà sao cứ bị báo lỗi

    Nhờ các Anh chi xem giúp với ạ. E xin cảm ơn !
     

    File đính kèm

    Upvote 0
    - E có file về tạo ListBox và có thắc mắc sau:
    - Khi Click vào Save trong Form thì bị lỗi ở cột thứ 11, mày mò mãi vẫn chưa thể hiểu đc nguyên nhân vì thấy nó đúng mà sao cứ bị báo lỗi

    Nhờ các Anh chi xem giúp với ạ. E xin cảm ơn !

    Listbox là bị vậy, bạn phải gán Array trước, hoặc row resources, sau đó mới sử dụng được kiểu gán như vậy cho các cột từ thứ 10 đi
     
    Upvote 0
    Upvote 0
    Với ví dụ này của mình, bạn có thể giúp mình gán bằng array đc ko ?

    Chỉ cần đổi Sub Ghi_Click thành thế này

    Mã:
    Private Sub Ghi_Click()
        With HangChiTiet
            If .ListCount = 0 Then
                ReDim a(0 To 0, 0 To 10)
                .List = a
                .List(.ListCount - 1, 0) = Ma
            Else
                .AddItem Ma
            End If
            .List(.ListCount - 1, 1) = TenHang
            .List(.ListCount - 1, 2) = DV
            .List(.ListCount - 1, 3) = SL
            .List(.ListCount - 1, 4) = DonGia
            .List(.ListCount - 1, 5) = KhuyenMai
            .List(.ListCount - 1, 6) = ChietKhau
            .List(.ListCount - 1, 7) = TangGiam
            .List(.ListCount - 1, 8) = DoanhThu
            .List(.ListCount - 1, 9) = TienMat
            .List(.ListCount - 1, 10) = NganHang
            .ListIndex = .ListCount - 1 'chon row cuoi cung
        End With
    
        TongThanhToan = Format((TongThanhToan + 0) + (DoanhThu + 0), "#,##0")
    
    End Sub

    TongThanhToan là cái gì thì tôi không biết nhé để nguyên như cũ

    Nhưng kiểu form này chỉ dọa thui, còn thiếu thực dụng, ở sheet thao tác nhanh hơn nhiều, vì thế người ta ít dụng kiểu listbox listview để nhập, chỉ dùng để trình bày dữ liệu, kết quả cho đẹp mà thôi, hoặc nhập các thứ bé bé nho nhỏ, kiểu lựa chọn files...
     
    Lần chỉnh sửa cuối:
    Upvote 0
    Chỉ cần đổi Sub Ghi_Click thành thế này

    Mã:
    Private Sub Ghi_Click()
        With HangChiTiet
            If .ListCount = 0 Then
                ReDim a(0 To 0, 0 To 10)
                .List = a
                .List(.ListCount - 1, 0) = Ma
            Else
                .AddItem Ma
            End If
            .List(.ListCount - 1, 1) = TenHang
            .List(.ListCount - 1, 2) = DV
            .List(.ListCount - 1, 3) = SL
            .List(.ListCount - 1, 4) = DonGia
            .List(.ListCount - 1, 5) = KhuyenMai
            .List(.ListCount - 1, 6) = ChietKhau
            .List(.ListCount - 1, 7) = TangGiam
            .List(.ListCount - 1, 8) = DoanhThu
            .List(.ListCount - 1, 9) = TienMat
            .List(.ListCount - 1, 10) = NganHang
            .ListIndex = .ListCount - 1 'chon row cuoi cung
        End With
    
        TongThanhToan = Format((TongThanhToan + 0) + (DoanhThu + 0), "#,##0")
    
    End Sub

    TongThanhToan là cái gì thì tôi không biết nhé để nguyên như cũ

    Nhưng kiểu form này chỉ dọa thui, còn thiếu thực dụng, ở sheet thao tác nhanh hơn nhiều, vì thế người ta ít dụng kiểu listbox listview để nhập, chỉ dùng để trình bày dữ liệu, kết quả cho đẹp mà thôi, hoặc nhập các thứ bé bé nho nhỏ, kiểu lựa chọn files...

    Cảm ơn ban. Nhưng mà bữa nào rảnh bạn đổi tên qua Win10 chơi chút nhé bạn :D
     
    Upvote 0
    - E có file về tạo ListBox và có thắc mắc sau:
    - Khi Click vào Save trong Form thì bị lỗi ở cột thứ 11, mày mò mãi vẫn chưa thể hiểu đc nguyên nhân vì thấy nó đúng mà sao cứ bị báo lỗi

    Nhờ các Anh chi xem giúp với ạ. E xin cảm ơn !

    Thử mần xem nó là cái gì... kết quả chịu luôn --=0
     

    File đính kèm

    Upvote 0
    Xin chào các Anh chị, E có file sau về Scripting.Dictionary. Nhờ Các anh chị xem giúp ạ


    Sub Mang() Dim Sarr(), Arr(), i As Long, Tem As String, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    Sarr = Range("B4", Range("B4").End(xlDown)).Resize(, 2).Value
    For i = 1 To UBound(Sarr)
    Tem = Trim(Sarr(i, 1))
    dic.Item(Tem) = Sarr(i, 2)
    Next i
    Sarr = Range("G4", Range("G4").End(xlDown)).Value
    ReDim Arr(1 To UBound(Sarr), 1 To 1)
    For i = 1 To UBound(Sarr)
    Tem = Trim(Sarr(i, 1))
    If dic.exists(Tem) Then
    Arr(i, 1) = dic.Item(Tem)
    Else:
    dic.Add Tem, ""
    Arr(i, 1) = dic.Count
    End If
    Next i
    Range("I4").Resize(i - 1) = Arr
    End Sub

    - Trong file e đã giải thích về thắc mắc của code
    - Theo như ý hiểu, mong muốn trong file là Item thứ 15 của Dic, nhưng chưa bít cách nào để lấy được nó ạ
     

    File đính kèm

    Lần chỉnh sửa cuối:
    Upvote 0
    Xin chào các Anh chị, E có file sau về Scripting.Dictionary. Nhờ Các anh chị xem giúp ạ


    Sub Mang() Dim Sarr(), Arr(), i As Long, Tem As String, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    Sarr = Range("B4", Range("B4").End(xlDown)).Resize(, 2).Value
    For i = 1 To UBound(Sarr)
    Tem = Trim(Sarr(i, 1))
    dic.Item(Tem) = Sarr(i, 2)
    Next i
    Sarr = Range("G4", Range("G4").End(xlDown)).Value
    ReDim Arr(1 To UBound(Sarr), 1 To 1)
    For i = 1 To UBound(Sarr)
    Tem = Trim(Sarr(i, 1))
    If dic.exists(Tem) Then
    Arr(i, 1) = dic.Item(Tem)
    Else:
    dic.Add Tem, "" Đoạn này sửa thành dic.Add Tem, dic.count + 1
    Arr(i, 1) = dic.Count
    End If
    Next i
    Range("I4").Resize(i - 1) = Arr
    End Sub

    E làm được rùi, sửa như trên là đc ! Cảm ơn mọi người !
     
    Upvote 0
    Cho em hỏi code này sai ở đâu mà khi chạy nó báo lỗi. Hiện báo lỗi vàng ở ngay dòng đầu tiên "With Application.Workbooks("HR Report OVT").Sheets("T12.2016")"
    (File HR Report OVT vẫn đang mở

    PHP:
    Option Explicit
     
    Public Sub SOS_Cong_OVT()
    Dim Dic As Object, Col As Object, Ws As Worksheet, Tem As String, Rws As Long
    Dim sArr(), dArr(1 To 10000, 1 To 36), I As Long, J As Long, K As Long, C As Long
    Set Dic = CreateObject("Scripting.Dictionary")
    Set Col = CreateObject("Scripting.Dictionary")
    With Application.Workbooks("HR Report OVT").Sheets("T12.2016")
        sArr = .Range("b7").Resize(, 37).Value
        For J = 1 To 37
            If sArr(1, J) <> Empty Then
                If IsDate(sArr(1, J)) Then Col.Item(Day(sArr(1, J))) = J
            End If
        Next J
    End With
    For Each Ws In Worksheets
        If Ws.Name <> "Form" And Ws.Name <> "Check" And Ws.Name <> "BCC" Then
            C = Col.Item(Val(Ws.Name))
            sArr = Ws.Range("C9", Ws.Range("C9").End(xlDown)).Resize(, 37).Value
            For I = 1 To UBound(sArr)
                Tem = sArr(I, 1)
                If Not Dic.Exists(Tem) Then
                    K = K + 1
                    Dic.Add Tem, K
                    dArr(K, 1) = sArr(I, 1)
                End If
                Rws = Dic.Item(Tem)
                dArr(Rws, C) = sArr(I, 20)
                  
            Next I
        End If
    Next Ws
     
    Application.Workbooks("HR Report OVT").Sheets("T12.2016").Range("b8").Resize(K, 37) = dArr
     
    Set Dic = Nothing
    Set Col = Nothing
    End Sub
     
    Lần chỉnh sửa cuối:
    Upvote 0
    thử chỉ rõ đuôi File của HR Report OVT
    ví dụ như
    With Application.Workbooks("HR Report OVT.xlsx").Sheets("T12.2016")
     
    Upvote 0
    Web KT

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

    Back
    Top Bottom